{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ImplicitParams #-}

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

import Prelude hiding (LT, GT)

import EVM.Types
import EVM (traceForest, traceForest', traceContext, cheatCode)
import EVM.ABI (getAbiSeq, parseTypeName, AbiValue(..), AbiType(..), SolError(..), Indexed(..), Event(..))
import EVM.Dapp (DappContext(..), DappInfo(..), findSrc, showTraceLocation)
import EVM.Expr qualified as Expr
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, sort)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text, pack, unpack, intercalate, dropEnd, splitOn)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Tree.View (showTree)
import Data.Vector (Vector)
import Hexdump (prettyHex)
import Numeric (showHex)
import Data.ByteString.Char8 qualified as Char8
import Data.ByteString.Base16 qualified as BS16
import Witch (into, unsafeInto, tryFrom)

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

showDec :: Signedness -> W256 -> Text
showDec :: Signedness -> W256 -> Text
showDec Signedness
signed (W256 Word256
w)
  | Right Addr
i' <- Integer -> Either (TryFromException Integer Addr) Addr
forall source target.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryFrom Integer
i, Addr -> Expr 'EAddr
LitAddr Addr
i' Expr 'EAddr -> Expr 'EAddr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr 'EAddr
cheatCode = Text
"<hevm cheat address>"
  | (Integer
i :: Integer) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
256 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 = Text
"MAX_UINT256"
  | Bool
otherwise = [Char] -> Text
T.pack (Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer
i :: Integer))
  where
    i :: Integer
i = case Signedness
signed of
          Signedness
Signed   -> Int256 -> Integer
forall target source. From source target => source -> target
into (Word256 -> SignedWord Word256
forall w. BinaryWord w => w -> SignedWord w
signedWord Word256
w)
          Signedness
Unsigned -> Word256 -> Integer
forall target source. From source target => source -> target
into Word256
w

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

showWordExplanation :: W256 -> DappInfo -> Text
showWordExplanation :: W256 -> DappInfo -> Text
showWordExplanation W256
w DappInfo
_ | W256
w W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
0xffffffff = Signedness -> W256 -> Text
showDec Signedness
Unsigned W256
w
showWordExplanation W256
w DappInfo
dapp =
  case FunctionSelector -> Map FunctionSelector Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
w) DappInfo
dapp.abiMap of
    Maybe Method
Nothing -> Signedness -> W256 -> Text
showDec Signedness
Unsigned W256
w
    Just Method
x  -> Text
"keccak(\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Method
x.methodSignature Text -> Text -> Text
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
","
  ([Text] -> Text) -> (a -> [Text]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
  ([Text] -> [Text]) -> (a -> [Text]) -> a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.reverse
  ([Text] -> [Text]) -> (a -> [Text]) -> a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
T.chunksOf Int
3
  (Text -> [Text]) -> (a -> Text) -> a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse
  (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
  ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

prettyIfConcreteWord :: Expr EWord -> Text
prettyIfConcreteWord :: Expr 'EWord -> Text
prettyIfConcreteWord = \case
  Lit W256
w -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"0x" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> W256 -> ShowS
forall a. Integral a => a -> ShowS
showHex W256
w [Char]
""
  Expr 'EWord
w -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> [Char]
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 name :: Text
name = case Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Addr -> Expr 'EAddr
LitAddr Addr
addr) ?context::DappContext
DappContext
?context.env of
        Maybe Contract
Nothing -> Text
""
        Just Contract
contract -> Maybe SolcContract -> Text
maybeContractName' (Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
contract ?context::DappContext
DappContext
?context.info)
  in
    Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
addr)
showAbiValue AbiValue
v = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ AbiValue -> [Char]
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 = Vector Text -> [Text]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((AbiValue -> Text) -> Vector AbiValue -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (?context::DappContext) => AbiValue -> Text
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 Get (Vector AbiValue)
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char])
     (ByteString, ByteOffset, Vector AbiValue)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
runGetOrFail (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq ([AbiType] -> Int
forall a. [a] -> Int
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]
Vector AbiValue -> [Text]
textAbiValues Vector AbiValue
xs
    Left (ByteString
_, ByteOffset
_, [Char]
_)   -> [ByteString -> Text
formatBinary ByteString
bs]
textValues [AbiType]
ts Expr 'Buf
_ = (AbiType -> Text) -> [AbiType] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> AbiType -> Text
forall a b. a -> b -> a
const Text
"<symbolic>") [AbiType]
ts

parenthesise :: [Text] -> Text
parenthesise :: [Text] -> Text
parenthesise [Text]
ts = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
ts Text -> Text -> Text
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 ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
[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 = [Text] -> Text
forall a. HasCallStack => [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
[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
[AbiType] -> Expr 'Buf -> Text
showValues [AbiType]
ts (Expr 'Buf -> Text) -> Expr 'Buf -> Text
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
DappContext
?context.info
      bs4 :: ByteString
bs4 = Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs
  in case W256 -> Map W256 SolError -> Maybe SolError
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
[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
[AbiType] -> Expr 'Buf -> Text
showCall [AbiType
AbiStringType] (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs)
                  -- Method ID for Panic(uint256)
                  ByteString
"NH{q"        -> Text
"Panic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
[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 ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> [Char]
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' (ByteString -> Either UnicodeException Text)
-> (Either UnicodeException Text -> Bool) -> ByteString -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    (UnicodeException -> Bool)
-> (Text -> Bool) -> Either UnicodeException Text -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (Bool -> UnicodeException -> Bool
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 (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
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 (Word8 -> Word8 -> Bool
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 = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"«",  (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'"') ([Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
formatString ByteString
b), Text
"»" ]

formatBinary :: ByteString -> Text
formatBinary :: ByteString -> Text
formatBinary =
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"0x" (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
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
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" abstract buf>"
formatSBinary Expr 'Buf
_ = [Char] -> Text
forall a. HasCallStack => [Char] -> a
internalError [Char]
"formatSBinary: implement me"

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

showTraceTree' :: DappInfo -> Expr End -> Text
showTraceTree' :: DappInfo -> Expr 'End -> Text
showTraceTree' DappInfo
_ (ITE {}) = [Char] -> Text
forall a. HasCallStack => [Char] -> a
internalError [Char]
"ITE does not contain a trace"
showTraceTree' DappInfo
dapp Expr 'End
leaf =
  let forest :: Forest Trace
forest = Expr 'End -> Forest Trace
traceForest' Expr 'End
leaf
      traces :: [Tree [Char]]
traces = (Tree Trace -> Tree [Char]) -> Forest Trace -> [Tree [Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Trace -> [Char]) -> Tree Trace -> Tree [Char]
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Char]
unpack (Text -> [Char]) -> (Trace -> Text) -> Trace -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DappInfo -> Map (Expr 'EAddr) Contract -> Trace -> Text
showTrace DappInfo
dapp (Expr 'End -> Map (Expr 'EAddr) Contract
traceContext Expr 'End
leaf))) Forest Trace
forest
  in [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ (Tree [Char] -> [Char]) -> [Tree [Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree [Char] -> [Char]
showTree [Tree [Char]]
traces

showTrace :: DappInfo -> Map (Expr EAddr) Contract -> Trace -> Text
showTrace :: DappInfo -> Map (Expr 'EAddr) Contract -> Trace -> Text
showTrace DappInfo
dapp Map (Expr 'EAddr) Contract
env Trace
trace =
  let ?context = DappContext { $sel:info:DappContext :: DappInfo
info = DappInfo
dapp, $sel:env:DappContext :: Map (Expr 'EAddr) Contract
env = Map (Expr 'EAddr) Contract
env }
  in let
    pos :: Text
pos =
      case DappInfo -> Trace -> Either Text Text
showTraceLocation DappInfo
dapp Trace
trace of
        Left Text
x -> Text
" \x1b[1m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[0m"
        Right Text
x -> Text
" \x1b[1m(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\x1b[0m"
  in case Trace
trace.tracedata of
    EventTrace Expr 'EWord
_ Expr 'Buf
bytes [Expr 'EWord]
topics ->
      case [Expr 'EWord]
topics of
        [] ->
          Text
logn
        Expr 'EWord
firstTopic:[Expr 'EWord]
restTopics ->
          case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
firstTopic of
            Just W256
topic ->
              case W256 -> Map W256 Event -> Maybe Event
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)]
argInfos) ->
                  Text -> [(Text, AbiType, Indexed)] -> [Expr 'EWord] -> Text
showEvent Text
name [(Text, AbiType, Indexed)]
argInfos [Expr 'EWord]
restTopics
                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 = W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (W256 -> FunctionSelector) -> W256 -> FunctionSelector
forall a b. (a -> b) -> a -> b
$ W256 -> Int -> W256
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 ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Addr -> [Char]
forall a. Show a => a -> [Char]
show (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
w :: Addr)
                          Maybe W256
Nothing  ->
                            Text
"<symbolic>"
                      in
                        case FunctionSelector -> Map FunctionSelector Method -> Maybe Method
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
      where
        logn :: Text
logn = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"\x1b[36m"
          , Text
"log" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show ([Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
topics)))
          , [Text] -> Text
parenthesise (((Expr 'EWord -> Text) -> [Expr 'EWord] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
pack ([Char] -> Text) -> (Expr 'EWord -> [Char]) -> Expr 'EWord -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> [Char]
forall a. Show a => a -> [Char]
show) [Expr 'EWord]
topics) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Expr 'Buf -> Text
formatSBinary Expr 'Buf
bytes])
          , Text
"\x1b[0m"
          ] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos

        showEvent :: Text -> [(Text, AbiType, Indexed)] -> [Expr 'EWord] -> Text
showEvent Text
eventName [(Text, AbiType, Indexed)]
argInfos [Expr 'EWord]
indexedTopics = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"\x1b[36m"
          , Text
eventName
          , [Text] -> Text
parenthesise ((Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Text)] -> [(Int, Text)]
forall a. Ord a => [a] -> [a]
sort ([(Int, Text)]
unindexedArgs [(Int, Text)] -> [(Int, Text)] -> [(Int, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Text)]
indexedArgs))
          , Text
"\x1b[0m"
          ] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos
          where
          -- We maintain the original position of event arguments since indexed
          -- and not indexed arguments can be interleaved.
          unindexedArgs :: [(Int, Text)]
          unindexedArgs :: [(Int, Text)]
unindexedArgs =
            let ([Int]
positions, [Text]
names, [AbiType]
abiTypes) = [(Int, Text, AbiType)] -> ([Int], [Text], [AbiType])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (Indexed -> [(Int, Text, AbiType)]
filterArgInfos Indexed
NotIndexed)
            in [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
positions ((Text -> Text -> Text) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Text -> Text
withName [Text]
names ((?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
[AbiType] -> Expr 'Buf -> [Text]
textValues [AbiType]
abiTypes Expr 'Buf
bytes))

          indexedArgs :: [(Int, Text)]
          indexedArgs :: [(Int, Text)]
indexedArgs =
            let ([Int]
positions, [Text]
names, [AbiType]
abiTypes) = [(Int, Text, AbiType)] -> ([Int], [Text], [AbiType])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (Indexed -> [(Int, Text, AbiType)]
filterArgInfos Indexed
Indexed)
            in [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
positions ((Text -> Text -> Text) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Text -> Text
withName [Text]
names ((AbiType -> Expr 'EWord -> Text)
-> [AbiType] -> [Expr 'EWord] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith AbiType -> Expr 'EWord -> Text
showTopic [AbiType]
abiTypes [Expr 'EWord]
indexedTopics))
            where
            showTopic :: AbiType -> Expr EWord -> Text
            showTopic :: AbiType -> Expr 'EWord -> Text
showTopic AbiType
abiType Expr 'EWord
topic =
              case Expr 'EWord -> Maybe W256
maybeLitWord (Expr 'EWord -> Expr 'EWord
forall (a :: EType). Expr a -> Expr a
Expr.concKeccakSimpExpr Expr 'EWord
topic) of
                Just W256
w -> [Text] -> Text
forall a. HasCallStack => [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
[AbiType] -> Expr 'Buf -> [Text]
textValues [AbiType
abiType] (ByteString -> Expr 'Buf
ConcreteBuf (W256 -> ByteString
word256Bytes W256
w))
                Maybe W256
_ -> Text
"<symbolic>"

          withName :: Text -> Text -> Text
          withName :: Text -> Text -> Text
withName Text
"" Text
value = Text
value
          withName Text
argName Text
value = Text
argName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value

          filterArgInfos :: Indexed -> [(Int, Text, AbiType)]
          filterArgInfos :: Indexed -> [(Int, Text, AbiType)]
filterArgInfos Indexed
which =
            [ (Int
i, Text
argName, AbiType
argType) | (Int
i, (Text
argName, AbiType
argType, Indexed
indexed)) <- [Int]
-> [(Text, AbiType, Indexed)] -> [(Int, (Text, AbiType, Indexed))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Text, AbiType, Indexed)]
argInfos
                                    , Indexed
indexed Indexed -> Indexed -> Bool
forall a. Eq a => a -> a -> Bool
== Indexed
which
            ]

        lognote :: Text -> Text -> Text
lognote Text
sig Text
usr = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"\x1b[36m"
          , Text
"LogNote"
          , [Text] -> Text
parenthesise [Text
sig, Text
usr, Text
"..."]
          , Text
"\x1b[0m"
          ] Text -> Text -> Text
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Revert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => Expr 'Buf -> Text
Expr 'Buf -> Text
showError Expr 'Buf
out Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos
        EvmError
_ ->
          Text
"\x1b[91merror\x1b[0m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (EvmError -> [Char]
forall a. Show a => a -> [Char]
show EvmError
e) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos

    ReturnTrace Expr 'Buf
out (CallContext { $sel:abi:CreationContext :: FrameContext -> Maybe W256
abi = Just W256
abi }) ->
      Text
"← " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        case FunctionSelector -> Map FunctionSelector Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
abi) DappInfo
dapp.abiMap of
          Just Method
m  ->
            case [(Text, AbiType)] -> ([Text], [AbiType])
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
[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
"← " Text -> Text -> 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
"← " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes of code"
    EntryTrace Text
t ->
      Text
t
    FrameTrace (CreationContext { Expr 'EAddr
address :: Expr 'EAddr
$sel:address:CreationContext :: FrameContext -> Expr 'EAddr
address }) ->
      Text
"create "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe SolcContract -> Text
maybeContractName (Expr 'EAddr -> Maybe SolcContract
findSrcFromAddr Expr 'EAddr
address)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EAddr -> Text
formatAddr Expr 'EAddr
address
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos
    FrameTrace (CallContext { Expr 'EAddr
target :: Expr 'EAddr
$sel:target:CreationContext :: FrameContext -> Expr 'EAddr
target, Expr 'EAddr
context :: Expr 'EAddr
$sel:context:CreationContext :: FrameContext -> Expr 'EAddr
context, Maybe W256
$sel:abi:CreationContext :: FrameContext -> Maybe W256
abi :: Maybe W256
abi, Expr 'Buf
calldata :: Expr 'Buf
$sel:calldata:CreationContext :: FrameContext -> Expr 'Buf
calldata }) ->
      let calltype :: Text
calltype = if Expr 'EAddr
target Expr 'EAddr -> Expr 'EAddr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr 'EAddr
context
                     then Text
"call "
                     else Text
"delegatecall "
      in case Expr 'EAddr -> Maybe SolcContract
findSrcFromAddr Expr 'EAddr
target of
        Maybe SolcContract
Nothing ->
          Text
calltype
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Expr 'EAddr
target of
                 LitAddr Addr
0x7109709ECfa91a80626fF3989D68f67F5b1DD12D -> Text
"HEVM"
                 Expr 'EAddr
_ -> Expr 'EAddr -> Text
formatAddr Expr 'EAddr
target
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack [Char]
"::"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case FunctionSelector -> Map FunctionSelector Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (W256 -> Maybe W256 -> W256
forall a. a -> Maybe a -> a
fromMaybe W256
0x00 Maybe W256
abi)) DappInfo
dapp.abiMap of
                 Just Method
m  ->
                   Text
"\x1b[1m"
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Method
m.name
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[0m"
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
[AbiType] -> Expr 'Buf -> Text
showCall ([Maybe AbiType] -> [AbiType]
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
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos

        Just SolcContract
solc ->
          Text
calltype
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[1m"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
contractNamePart SolcContract
solc.contractName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (W256 -> Text) -> Maybe W256 -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"[fallback function]"
                 (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"[unknown method]" (Maybe Text -> Text) -> (W256 -> Maybe Text) -> W256 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolcContract -> W256 -> Maybe Text
maybeAbiName SolcContract
solc)
                 Maybe W256
abi
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> ([Maybe AbiType] -> Text) -> Maybe [Maybe AbiType] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'Buf -> Text
formatSBinary Expr 'Buf
calldata Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
                 (\[Maybe AbiType]
x -> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
[AbiType] -> Expr 'Buf -> Text
showCall ([Maybe AbiType] -> [AbiType]
forall a. [Maybe a] -> [a]
catMaybes [Maybe AbiType]
x) Expr 'Buf
calldata)
                 (Maybe W256
abi Maybe W256
-> (W256 -> Maybe [Maybe AbiType]) -> Maybe [Maybe AbiType]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> [Maybe AbiType]) -> Maybe Text -> Maybe [Maybe AbiType]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Maybe AbiType]
getAbiTypes (Maybe Text -> Maybe [Maybe AbiType])
-> (W256 -> Maybe Text) -> W256 -> Maybe [Maybe AbiType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolcContract -> W256 -> Maybe Text
maybeAbiName SolcContract
solc)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[0m"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos
    where
    findSrcFromAddr :: Expr 'EAddr -> Maybe SolcContract
findSrcFromAddr Expr 'EAddr
addr = do
      Contract
contract <- Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Expr 'EAddr
addr Map (Expr 'EAddr) Contract
env
      Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
contract DappInfo
dapp

formatAddr :: Expr EAddr -> Text
formatAddr :: Expr 'EAddr -> Text
formatAddr = \case
  LitAddr Addr
a -> [Char] -> Text
pack (Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
a)
  SymAddr Text
a -> Text
"symbolic(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  GVar GVar 'EAddr
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"

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

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

maybeContractName' :: Maybe SolcContract -> Text
maybeContractName' :: Maybe SolcContract -> Text
maybeContractName' =
  Text -> (SolcContract -> Text) -> Maybe SolcContract -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text
contractNamePart (Text -> Text) -> (SolcContract -> Text) -> SolcContract -> Text
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 = FunctionSelector -> Map FunctionSelector Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
abi) SolcContract
solc.abiMap Maybe Method -> (Method -> Text) -> Maybe Text
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
x [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
1

contractPathPart :: Text -> Text
contractPathPart :: Text -> Text
contractPathPart Text
x = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
x [Text] -> Int -> Text
forall a. HasCallStack => [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 Expr 'EWord
a Expr 'EWord
b -> [Char]
"Balance too low. value: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> [Char]
forall a. Show a => a -> [Char]
show Expr 'EWord
a [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" balance: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> [Char]
forall a. Show a => a -> [Char]
show Expr 'EWord
b
  UnrecognizedOpcode Word8
a -> [Char]
"Unrecognized opcode: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
a
  Revert (ConcreteBuf ByteString
msg) -> [Char]
"Revert: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
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: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
a [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" need: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
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: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
a [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" actual: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
b
  MaxInitCodeSizeExceeded W256
a Expr 'EWord
b -> [Char]
"Max init code size exceeded: max: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
a [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" actual: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> [Char]
forall a. Show a => a -> [Char]
show Expr 'EWord
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: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionSelector -> [Char]
forall a. Show a => a -> [Char]
show FunctionSelector
a
  NonexistentFork Int
a -> [Char]
"Fork ID does not exist: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
a

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

indent :: Int -> Text -> Text
indent :: Int -> Text -> Text
indent Int
n = Text -> Text
rstrip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
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
' ']) <>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') (Text -> Text) -> (Text -> Text) -> Text -> Text
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
    , Text
")"
    ]
  EvmError
e -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ EvmError -> [Char]
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
      [ Text
"msg: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ShowS
forall a. Show a => a -> [Char]
show [Char]
msg)
      , Text
"program counter: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pc)
      , Text
"arguments: "
      , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> ([SomeExpr] -> [Text]) -> [SomeExpr] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeExpr -> Text) -> [SomeExpr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeExpr -> Text
formatSomeExpr ([SomeExpr] -> Text) -> [SomeExpr] -> Text
forall a b. (a -> b) -> a -> b
$ [SomeExpr]
args
      ]
    ]
  MaxIterationsReached Int
pc Expr 'EAddr
addr -> Text
"Max Iterations Reached in contract: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EAddr -> Text
formatAddr Expr 'EAddr
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" pc: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pc)
  JumpIntoSymbolicCode Int
pc Int
idx -> Text
"Encountered a jump into a potentially symbolic code region while executing initcode. pc: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" jump dst: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx)

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

formatExpr :: Expr a -> Text
formatExpr :: forall (a :: EType). Expr a -> Text
formatExpr = Expr a -> Text
forall (a :: EType). Expr a -> Text
go
  where
    go :: Expr a -> Text
    go :: forall (a :: EType). Expr a -> Text
go Expr a
x = Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ case Expr a
x of
      Lit W256
w -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show (W256 -> Integer
forall target source. From source target => source -> target
into W256
w :: Integer)
      (Var Text
v) -> Text
"(Var " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      (GVar GVar a
v) -> Text
"(GVar " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (GVar a -> [Char]
forall a. Show a => a -> [Char]
show GVar a
v) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      LitByte Word8
w -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
w

      ITE Expr 'EWord
c Expr 'End
t Expr 'End
f -> [Text] -> Text
T.unlines
        [ Text
"(ITE"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
c
          , Expr 'End -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'End
t
          , Expr 'End -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'End
f
          ]
        , Text
")"]
      Success [Prop]
asserts Traces
_ Expr 'Buf
buf Map (Expr 'EAddr) (Expr 'EContract)
store -> [Text] -> Text
T.unlines
        [ Text
"(Success"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"Data:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          , Text
""
          , Text
"State:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines (((Expr 'EAddr, Expr 'EContract) -> Text)
-> [(Expr 'EAddr, Expr 'EContract)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Expr 'EAddr
k,Expr 'EContract
v) ->
              [Text] -> Text
T.unlines
                [ Expr 'EAddr -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EAddr
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EContract -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EContract
v
                ]) (Map (Expr 'EAddr) (Expr 'EContract)
-> [(Expr 'EAddr, Expr 'EContract)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Expr 'EAddr) (Expr 'EContract)
store))
          , Text
"Assertions:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Prop -> Text) -> [Prop] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Text
formatProp [Prop]
asserts
          ]
        , Text
")"
        ]
      Partial [Prop]
asserts Traces
_ PartialExec
err -> [Text] -> Text
T.unlines
        [ Text
"(Partial"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"Reason:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ PartialExec -> Text
formatPartial PartialExec
err
          , Text
"Assertions:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Prop -> Text) -> [Prop] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Text
formatProp [Prop]
asserts
          ]
        , Text
")"
        ]
      Failure [Prop]
asserts Traces
_ EvmError
err -> [Text] -> Text
T.unlines
        [ Text
"(Failure"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"Error:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EvmError -> Text
formatError EvmError
err
          , Text
"Assertions:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Prop -> Text) -> [Prop] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Text
formatProp [Prop]
asserts
          ]
        , Text
")"
        ]

      IndexWord Expr 'EWord
idx Expr 'EWord
val -> [Text] -> Text
T.unlines
        [ Text
"(IndexWord"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"val: "
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"buf: "
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          ]
        , Text
")"
        ]
      ReadByte Expr 'EWord
idx Expr 'Buf
buf -> [Text] -> Text
T.unlines
        [ Text
"(ReadByte"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"buf: "
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          ]
        , Text
")"
        ]

      Add Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Add" [Expr 'EWord
a, Expr 'EWord
b]
      Sub Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Sub" [Expr 'EWord
a, Expr 'EWord
b]
      Mul Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Mul" [Expr 'EWord
a, Expr 'EWord
b]
      Div Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Div" [Expr 'EWord
a, Expr 'EWord
b]
      SDiv Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SDiv" [Expr 'EWord
a, Expr 'EWord
b]
      Mod Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Mod" [Expr 'EWord
a, Expr 'EWord
b]
      SMod Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SMod" [Expr 'EWord
a, Expr 'EWord
b]
      AddMod Expr 'EWord
a Expr 'EWord
b Expr 'EWord
c -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"AddMod" [Expr 'EWord
a, Expr 'EWord
b, Expr 'EWord
c]
      MulMod Expr 'EWord
a Expr 'EWord
b Expr 'EWord
c -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"MulMod" [Expr 'EWord
a, Expr 'EWord
b, Expr 'EWord
c]
      Exp Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Exp" [Expr 'EWord
a, Expr 'EWord
b]
      SEx Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SEx" [Expr 'EWord
a, Expr 'EWord
b]
      Min Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Min" [Expr 'EWord
a, Expr 'EWord
b]
      Max Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Max" [Expr 'EWord
a, Expr 'EWord
b]

      LT Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"LT" [Expr 'EWord
a, Expr 'EWord
b]
      GT Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"GT" [Expr 'EWord
a, Expr 'EWord
b]
      LEq Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"LEq" [Expr 'EWord
a, Expr 'EWord
b]
      GEq Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"GEq" [Expr 'EWord
a, Expr 'EWord
b]
      SLT Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SLT" [Expr 'EWord
a, Expr 'EWord
b]
      SGT Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SGT" [Expr 'EWord
a, Expr 'EWord
b]
      Eq Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Eq" [Expr 'EWord
a, Expr 'EWord
b]
      EqByte Expr 'Byte
a Expr 'Byte
b -> Text -> [Expr 'Byte] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"EqByte" [Expr 'Byte
a, Expr 'Byte
b]
      IsZero Expr 'EWord
a -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"IsZero" [Expr 'EWord
a]

      And Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"And" [Expr 'EWord
a, Expr 'EWord
b]
      Or Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Or" [Expr 'EWord
a, Expr 'EWord
b]
      Xor Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Xor" [Expr 'EWord
a, Expr 'EWord
b]
      Not Expr 'EWord
a -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Not" [Expr 'EWord
a]
      SHL Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SHL" [Expr 'EWord
a, Expr 'EWord
b]
      SHR Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SHR" [Expr 'EWord
a, Expr 'EWord
b]
      SAR Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SAR" [Expr 'EWord
a, Expr 'EWord
b]

      e :: Expr a
e@Expr a
Origin -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
Coinbase -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
Timestamp -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
BlockNumber -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
PrevRandao -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
GasLimit -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
ChainId -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
BaseFee -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@Expr a
TxValue -> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e)
      e :: Expr a
e@(Gas {}) -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
e) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

      BlockHash Expr 'EWord
a -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"BlockHash" [Expr 'EWord
a]
      Balance Expr 'EAddr
a -> Text -> [Expr 'EAddr] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Balance" [Expr 'EAddr
a]
      CodeSize Expr 'EAddr
a -> Text -> [Expr 'EAddr] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"CodeSize" [Expr 'EAddr
a]
      CodeHash Expr 'EAddr
a -> Text -> [Expr 'EAddr] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"CodeHash" [Expr 'EAddr
a]


      JoinBytes Expr 'Byte
zero Expr 'Byte
one Expr 'Byte
two Expr 'Byte
three Expr 'Byte
four Expr 'Byte
five Expr 'Byte
six Expr 'Byte
seven Expr 'Byte
eight Expr 'Byte
nine
        Expr 'Byte
ten Expr 'Byte
eleven Expr 'Byte
twelve Expr 'Byte
thirteen Expr 'Byte
fourteen Expr 'Byte
fifteen Expr 'Byte
sixteen Expr 'Byte
seventeen
        Expr 'Byte
eighteen Expr 'Byte
nineteen Expr 'Byte
twenty Expr 'Byte
twentyone Expr 'Byte
twentytwo Expr 'Byte
twentythree Expr 'Byte
twentyfour
        Expr 'Byte
twentyfive Expr 'Byte
twentysix Expr 'Byte
twentyseven Expr 'Byte
twentyeight Expr 'Byte
twentynine Expr 'Byte
thirty Expr 'Byte
thirtyone -> Text -> [Expr 'Byte] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"JoinBytes"
        [ Expr 'Byte
zero
        , Expr 'Byte
one
        , Expr 'Byte
two
        , Expr 'Byte
three
        , Expr 'Byte
four
        , Expr 'Byte
five
        , Expr 'Byte
six
        , Expr 'Byte
seven
        , Expr 'Byte
eight
        , Expr 'Byte
nine
        , Expr 'Byte
ten
        , Expr 'Byte
eleven
        , Expr 'Byte
twelve
        , Expr 'Byte
thirteen
        , Expr 'Byte
fourteen
        , Expr 'Byte
fifteen
        , Expr 'Byte
sixteen
        , Expr 'Byte
seventeen
        , Expr 'Byte
eighteen
        , Expr 'Byte
nineteen
        , Expr 'Byte
twenty
        , Expr 'Byte
twentyone
        , Expr 'Byte
twentytwo
        , Expr 'Byte
twentythree
        , Expr 'Byte
twentyfour
        , Expr 'Byte
twentyfive
        , Expr 'Byte
twentysix
        , Expr 'Byte
twentyseven
        , Expr 'Byte
twentyeight
        , Expr 'Byte
twentynine
        , Expr 'Byte
thirty
        , Expr 'Byte
thirtyone
        ]

      LogEntry Expr 'EWord
addr Expr 'Buf
dat [Expr 'EWord]
topics -> [Text] -> Text
T.unlines
        [ Text
"(LogEntry"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"addr:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
addr
          , Text
"data:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
dat
          , Text
"topics:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Expr 'EWord -> Text) -> [Expr 'EWord] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr [Expr 'EWord]
topics
          ]
        , Text
")"
        ]

      a :: Expr a
a@(SymAddr {}) -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      LitAddr Addr
a -> [Char] -> Text
T.pack (Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
a)
      WAddr Expr 'EAddr
a -> Text -> [Expr 'EAddr] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"WAddr" [Expr 'EAddr
a]

      BufLength Expr 'Buf
b -> Text -> [Expr 'Buf] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"BufLength" [Expr 'Buf
b]

      C ContractCode
code Expr 'Storage
store Expr 'EWord
bal Maybe W64
nonce -> [Text] -> Text
T.unlines
        [ Text
"(Contract"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"code:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ContractCode -> Text
formatCode ContractCode
code
          , Text
"storage:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Storage -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Storage
store
          , Text
"balance:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
bal
          , Text
"nonce:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe W64 -> Text
formatNonce Maybe W64
nonce
          ]
        , Text
")"
        ]

      -- Stores
      SLoad Expr 'EWord
slot Expr 'Storage
storage -> [Text] -> Text
T.unlines
        [ Text
"(SLoad"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"slot:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
slot
          , Text
"storage:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Storage -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Storage
storage
          ]
        , Text
")"
        ]
      SStore Expr 'EWord
slot Expr 'EWord
val Expr 'Storage
prev -> [Text] -> Text
T.unlines
        [ Text
"(SStore"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"slot:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
slot
          , Text
"val:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
val
          , Text
"store:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Storage -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Storage
prev          
          ]
        , Text
")"
        ]
      AbstractStore Expr 'EAddr
a Maybe W256
idx ->
        Text
"(AbstractStore " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EAddr -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EAddr
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Maybe W256 -> [Char]
forall a. Show a => a -> [Char]
show Maybe W256
idx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      ConcreteStore Map W256 W256
s -> if Map W256 W256 -> Bool
forall a. Map W256 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map W256 W256
s
        then Text
"(ConcreteStore <empty>)"
        else [Text] -> Text
T.unlines
          [ Text
"(ConcreteStore"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
            [ Text
"vals:"
            , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((W256, W256) -> Text) -> [(W256, W256)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Text
T.pack ([Char] -> Text)
-> ((W256, W256) -> [Char]) -> (W256, W256) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (W256, W256) -> [Char]
forall a. Show a => a -> [Char]
show) ([(W256, W256)] -> [Text]) -> [(W256, W256)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map W256 W256 -> [(W256, W256)]
forall k a. Map k a -> [(k, a)]
Map.toList 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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"srcOffset: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
srcOff
          , Text
"dstOffset: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
dstOff
          , Text
"size:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
size
          , Text
"src:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
src
          , Text
"dst:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
dst
          ]
        , Text
")"
        ]
      WriteWord Expr 'EWord
idx Expr 'EWord
val Expr 'Buf
buf -> [Text] -> Text
T.unlines
        [ Text
"(WriteWord"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"val:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
val
          , Text
"buf:"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          ]
        , Text
")"
        ]
      WriteByte Expr 'EWord
idx Expr 'Byte
val Expr 'Buf
buf -> [Text] -> Text
T.unlines
        [ Text
"(WriteByte"
        , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"val: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'Byte -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Byte
val
          , Text
"buf: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          ]
        , Text
")"
        ]
      ConcreteBuf ByteString
bs -> case ByteString
bs of
        ByteString
"" -> Text
"(ConcreteBuf \"\")"
        ByteString
_ -> [Text] -> Text
T.unlines
          [ Text
"(ConcreteBuf"
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
prettyHex ByteString
bs
          , Text
")"
          ]
      b :: Expr a
b@(AbstractBuf Text
_) -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
b) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

      -- Hashes
      Keccak Expr 'Buf
b -> Text -> [Expr 'Buf] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"Keccak" [Expr 'Buf
b]
      SHA256 Expr 'Buf
b -> Text -> [Expr 'Buf] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"SHA256" [Expr 'Buf
b]
      where
        fmt :: Text -> [Expr a] -> Text
fmt Text
nm [Expr a]
args = [Text] -> Text
T.unlines
          [ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm
          , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Expr a -> Text) -> [Expr a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr a -> Text
forall (a :: EType). Expr a -> Text
formatExpr [Expr a]
args
          , Text
")"
          ]

formatProp :: Prop -> Text
formatProp :: Prop -> Text
formatProp Prop
x = Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ case Prop
x of
  PEq Expr a
a Expr a
b -> Text -> [Expr a] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"PEq" [Expr a
a, Expr a
b]
  PLT Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"PLT" [Expr 'EWord
a, Expr 'EWord
b]
  PGT Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"PGT" [Expr 'EWord
a, Expr 'EWord
b]
  PGEq Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"PGEq" [Expr 'EWord
a, Expr 'EWord
b]
  PLEq Expr 'EWord
a Expr 'EWord
b -> Text -> [Expr 'EWord] -> Text
forall {a :: EType}. Text -> [Expr a] -> Text
fmt Text
"PLEq" [Expr 'EWord
a, Expr 'EWord
b]
  PNeg Prop
a -> Text -> [Prop] -> Text
fmt' Text
"PNeg" [Prop
a]
  PAnd Prop
a Prop
b -> Text -> [Prop] -> Text
fmt' Text
"PAnd" [Prop
a, Prop
b]
  POr Prop
a Prop
b -> Text -> [Prop] -> Text
fmt' Text
"POr" [Prop
a, Prop
b]
  PImpl Prop
a Prop
b -> Text -> [Prop] -> Text
fmt' Text
"PImpl" [Prop
a, Prop
b]
  PBool Bool
a -> [Char] -> Text
T.pack (Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
a)
  where
    fmt :: Text -> [Expr a] -> Text
fmt Text
nm [Expr a]
args = [Text] -> Text
T.unlines
      [ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm
      , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Expr a -> Text) -> [Expr a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr a -> Text
forall (a :: EType). Expr a -> Text
formatExpr [Expr a]
args
      , Text
")"
      ]
    fmt' :: Text -> [Prop] -> Text
fmt' Text
nm [Prop]
args = [Text] -> Text
T.unlines
      [ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm
      , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Prop -> Text) -> [Prop] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Text
formatProp [Prop]
args
      , Text
")"
      ]

formatNonce :: Maybe W64 -> Text
formatNonce :: Maybe W64 -> Text
formatNonce = \case
  Just W64
w -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ W64 -> [Char]
forall a. Show a => a -> [Char]
show W64
w
  Maybe W64
Nothing -> Text
"symbolic"

formatCode :: ContractCode -> Text
formatCode :: ContractCode -> Text
formatCode = \case
  UnknownCode Expr 'EAddr
_ -> Text
"Unknown"
  InitCode ByteString
c Expr 'Buf
d -> [Text] -> Text
T.unlines
    [ Text
"(InitCode"
    , Int -> Text -> Text
indent Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
      [ Text
"code: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
bsToHex ByteString
c)
      , Text
"data: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'Buf -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
d
      ]
    , Text
")"
    ]
  RuntimeCode (ConcreteRuntimeCode ByteString
c)
    -> Text
"(RuntimeCode " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
bsToHex ByteString
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
bs)
    -> Text
"(RuntimeCode " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Vector Text -> [Char]
forall a. Show a => a -> [Char]
show ((Expr 'Byte -> Text) -> Vector (Expr 'Byte) -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr 'Byte -> Text
forall (a :: EType). Expr a -> Text
formatExpr Vector (Expr 'Byte)
bs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"


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" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s then Int -> ShowS
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
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid hex bytestring for " [Char] -> ShowS
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
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid hex bytestring " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t

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

showVal :: AbiValue -> Text
showVal :: AbiValue -> Text
showVal (AbiBytes Int
_ ByteString
bs) = ByteString -> Text
formatBytes ByteString
bs
showVal (AbiAddress Addr
addr) = [Char] -> Text
T.pack  ([Char] -> Text) -> (Addr -> [Char]) -> Addr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> [Char]
forall a. Show a => a -> [Char]
show (Addr -> Text) -> Addr -> Text
forall a b. (a -> b) -> a -> b
$ Addr
addr
showVal AbiValue
v = [Char] -> Text
T.pack ([Char] -> Text) -> (AbiValue -> [Char]) -> AbiValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiValue -> [Char]
forall a. Show a => a -> [Char]
show (AbiValue -> Text) -> AbiValue -> Text
forall a b. (a -> b) -> a -> b
$ AbiValue
v