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

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

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

import Control.Arrow ((>>>))
import Optics.Core
import Data.Binary.Get (runGetOrFail)
import Data.Bits (shiftR)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Builder (byteStringHex, toLazyByteString)
import Data.ByteString.Lazy (toStrict, fromStrict)
import Data.Char qualified as Char
import Data.DoubleWord (signedWord)
import Data.Foldable (toList)
import Data.List (isPrefixOf)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe, fromJust)
import Data.Text (Text, pack, unpack, intercalate, dropEnd, splitOn)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Tree.View (showTree)
import Data.Vector (Vector)
import Numeric (showHex)
import Data.ByteString.Char8 qualified as Char8
import Data.ByteString.Base16 qualified as BS16
import Witch (into, unsafeInto)

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)
  | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Addr -> Integer
forall target source. From source target => source -> target
into Addr
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 :: W256 -> Text
showWordExact :: W256 -> Text
showWordExact W256
w = Integer -> Text
forall a. (Num a, Integral a, Show a) => a -> Text
humanizeInteger (W256 -> Integer
forall a. Integral a => a -> Integer
toInteger W256
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 dappinfo :: DappInfo
dappinfo = ?context::DappContext
DappContext
?context.info
      contracts :: Map Addr Contract
contracts = ?context::DappContext
DappContext
?context.env
      name :: Text
name = case Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
addr Map Addr Contract
contracts of
        Maybe Contract
Nothing -> Text
""
        Just Contract
contract ->
          let hash :: Maybe W256
hash = Expr 'EWord -> Maybe W256
maybeLitWord Contract
contract.codehash
          in case Maybe W256
hash of
               Just W256
h -> Maybe SolcContract -> Text
maybeContractName' (Optic'
  An_AffineTraversal
  NoIx
  (Map W256 (CodeType, SolcContract))
  SolcContract
-> Map W256 (CodeType, SolcContract) -> Maybe SolcContract
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index (Map W256 (CodeType, SolcContract))
-> Optic
     (IxKind (Map W256 (CodeType, SolcContract)))
     NoIx
     (Map W256 (CodeType, SolcContract))
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map W256 (CodeType, SolcContract))
W256
h Optic
  (IxKind (Map W256 (CodeType, SolcContract)))
  NoIx
  (Map W256 (CodeType, SolcContract))
  (Map W256 (CodeType, SolcContract))
  (IxValue (Map W256 (CodeType, SolcContract)))
  (IxValue (Map W256 (CodeType, SolcContract)))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map W256 (CodeType, SolcContract)))
     (IxValue (Map W256 (CodeType, SolcContract)))
     SolcContract
     SolcContract
-> Optic'
     An_AffineTraversal
     NoIx
     (Map W256 (CodeType, SolcContract))
     SolcContract
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map W256 (CodeType, SolcContract)))
  (IxValue (Map W256 (CodeType, SolcContract)))
  SolcContract
  SolcContract
forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dappinfo.solcByHash)
               Maybe W256
Nothing -> Text
""
  in
    Text
name 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 -> Text
showTraceTree :: DappInfo -> VM -> Text
showTraceTree DappInfo
dapp VM
vm =
  let forest :: Forest Trace
forest = VM -> Forest Trace
traceForest VM
vm
      traces :: [Tree [Char]]
traces = (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 Addr Contract -> Trace -> Text
showTrace DappInfo
dapp (VM
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
error [Char]
"Internal Error: 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 Addr Contract -> Trace -> Text
showTrace DappInfo
dapp (Expr 'End -> Map Addr 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

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 -> Map Addr Contract -> Trace -> Text
showTrace :: DappInfo -> Map Addr Contract -> Trace -> Text
showTrace DappInfo
dapp Map Addr Contract
env Trace
trace =
  let ?context = DappContext { $sel:info:DappContext :: DappInfo
info = DappInfo
dapp, $sel:env:DappContext :: Map Addr Contract
env = Map Addr 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"
    fullAbiMap :: Map FunctionSelector Method
fullAbiMap = DappInfo
dapp.abiMap
  in case Trace
trace.tracedata of
    EventTrace Expr 'EWord
_ Expr 'Buf
bytes [Expr 'EWord]
topics ->
      let logn :: Text
logn = [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
          knownTopic :: Text -> [(Text, AbiType, Indexed)] -> Text
knownTopic Text
name [(Text, AbiType, Indexed)]
types = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"\x1b[36m"
            , Text
name
            , (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
[AbiType] -> Expr 'Buf -> Text
showValues ([(Text, AbiType, Indexed)] -> [AbiType]
unindexed [(Text, AbiType, Indexed)]
types) Expr 'Buf
bytes
            -- todo: show indexed
            , Text
"\x1b[0m"
            ] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos
          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
      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 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)]
types) ->
                  Text -> [(Text, AbiType, Indexed)] -> Text
knownTopic Text
name [(Text, AbiType, Indexed)]
types
                Maybe Event
Nothing ->
                  case [Expr 'EWord]
topics of
                    [Expr 'EWord
_, Expr 'EWord
t2, Expr 'EWord
_, Expr 'EWord
_] ->
                      -- check for ds-note logs.. possibly catching false positives
                      -- event LogNote(
                      --     bytes4   indexed  sig,
                      --     address  indexed  usr,
                      --     bytes32  indexed  arg1,
                      --     bytes32  indexed  arg2,
                      --     bytes             data
                      -- ) anonymous;
                      let
                        sig :: FunctionSelector
sig = 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

    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 Addr
_ Addr
_ W256
_ W256
_ Expr 'EWord
_ (Just W256
abi) Expr 'Buf
_ (Map Addr Contract, Expr 'Storage)
_ SubState
_) ->
      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) Map FunctionSelector Method
fullAbiMap 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 Addr
addr (Lit W256
hash) Map Addr Contract
_ SubState
_ ) -> -- FIXME: irrefutable pattern
      Text
"create "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe SolcContract -> Text
maybeContractName (Optic'
  An_AffineTraversal
  NoIx
  (Map W256 (CodeType, SolcContract))
  SolcContract
-> Map W256 (CodeType, SolcContract) -> Maybe SolcContract
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index (Map W256 (CodeType, SolcContract))
-> Optic
     (IxKind (Map W256 (CodeType, SolcContract)))
     NoIx
     (Map W256 (CodeType, SolcContract))
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map W256 (CodeType, SolcContract))
W256
hash Optic
  (IxKind (Map W256 (CodeType, SolcContract)))
  NoIx
  (Map W256 (CodeType, SolcContract))
  (Map W256 (CodeType, SolcContract))
  (IxValue (Map W256 (CodeType, SolcContract)))
  (IxValue (Map W256 (CodeType, SolcContract)))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map W256 (CodeType, SolcContract)))
     (IxValue (Map W256 (CodeType, SolcContract)))
     SolcContract
     SolcContract
-> Optic'
     An_AffineTraversal
     NoIx
     (Map W256 (CodeType, SolcContract))
     SolcContract
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map W256 (CodeType, SolcContract)))
  (IxValue (Map W256 (CodeType, SolcContract)))
  SolcContract
  SolcContract
forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dapp.solcByHash)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
addr)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pos
    FrameTrace (CreationContext Addr
addr Expr 'EWord
_ Map Addr Contract
_ SubState
_ ) ->
      Text
"create "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<unknown contract>"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
addr)
      Text -> Text -> Text
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 Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
context
                     then Text
"call "
                     else Text
"delegatecall "
          hash' :: W256
hash' = Maybe W256 -> W256
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe W256 -> W256) -> Maybe W256 -> W256
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
hash
      in case Optic'
  An_AffineTraversal
  NoIx
  (Map W256 (CodeType, SolcContract))
  SolcContract
-> Map W256 (CodeType, SolcContract) -> Maybe SolcContract
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index (Map W256 (CodeType, SolcContract))
-> Optic
     (IxKind (Map W256 (CodeType, SolcContract)))
     NoIx
     (Map W256 (CodeType, SolcContract))
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map W256 (CodeType, SolcContract))
W256
hash' Optic
  (IxKind (Map W256 (CodeType, SolcContract)))
  NoIx
  (Map W256 (CodeType, SolcContract))
  (Map W256 (CodeType, SolcContract))
  (IxValue (Map W256 (CodeType, SolcContract)))
  (IxValue (Map W256 (CodeType, SolcContract)))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map W256 (CodeType, SolcContract)))
     (IxValue (Map W256 (CodeType, SolcContract)))
     SolcContract
     SolcContract
-> Optic'
     An_AffineTraversal
     NoIx
     (Map W256 (CodeType, SolcContract))
     SolcContract
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map W256 (CodeType, SolcContract)))
  (IxValue (Map W256 (CodeType, SolcContract)))
  SolcContract
  SolcContract
forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dapp.solcByHash of
        Maybe SolcContract
Nothing ->
          Text
calltype
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Addr
target of
                 Addr
0x7109709ECfa91a80626fF3989D68f67F5b1DD12D -> Text
"HEVM"
                 Addr
_ -> [Char] -> Text
pack (Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
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)) Map FunctionSelector Method
fullAbiMap 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

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 W256
a W256
b -> [Char]
"Balance too low. value: " [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]
" balance: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
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 W256
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
<> W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
b
  EvmError
InvalidFormat -> [Char]
"Invalid Format"
  EvmError
PrecompileFailure -> [Char]
"Precompile failure"
  EvmError
ReturnDataOutOfBounds -> [Char]
"Return data out of bounds"
  EvmError
NonceOverflow -> [Char]
"Nonce overflow"
  BadCheatCode FunctionSelector
a -> [Char]
"Bad cheat code: sig: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionSelector -> [Char]
forall a. Show a => a -> [Char]
show FunctionSelector
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) Expr 'Storage
_) =
  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
_ Expr 'Storage
_) =
  [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 Addr
addr -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Max Iterations Reached in contract: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
addr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" pc: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
pc

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 = \case
      Lit W256
w -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
w
      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
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
forall a b. (a -> b) -> a -> b
$
        [ Text
"(ITE (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr 'EWord -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        , Int -> Text -> Text
indent Int
2 (Expr 'End -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'End
t)
        , Int -> Text -> Text
indent Int
2 (Expr 'End -> Text
forall (a :: EType). Expr a -> Text
formatExpr Expr 'End
f)
        , Text
")"]
      Success [Prop]
asserts Traces
_ Expr 'Buf
buf Expr 'Storage
store -> [Text] -> Text
T.unlines
        [ Text
"(Return"
        , 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
"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
store
          , Text
"Assertions:"
          , 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
$ [Prop] -> [Char]
forall a. Show a => a -> [Char]
show [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
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Prop] -> [Char]
forall a. Show a => a -> [Char]
show [Prop]
asserts
          ]
        , Text
")"
        ]

      IndexWord Expr 'EWord
idx Expr 'EWord
val -> [Text] -> Text
T.unlines
        [ Text
"(IndexWord"
        , Int -> Text -> Text
indent Int
2 (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
")"
        ]

      And Expr 'EWord
a Expr 'EWord
b -> [Text] -> Text
T.unlines
        [ Text
"(And"
        , 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
a
          , Expr 'EWord -> Text
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 (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
"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
"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
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 (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
"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
")"
        , Expr 'Storage -> 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 (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, Text) -> Text) -> [(W256, Text)] -> [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, Text) -> [Char]) -> (W256, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (W256, Text) -> [Char]
forall a. Show a => a -> [Char]
show) ([(W256, Text)] -> [Text]) -> [(W256, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map W256 Text -> [(W256, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map W256 Text -> [(W256, Text)])
-> Map W256 Text -> [(W256, Text)]
forall a b. (a -> b) -> a -> b
$ (Map W256 W256 -> Text)
-> Map W256 (Map W256 W256) -> Map W256 Text
forall a b. (a -> b) -> Map W256 a -> Map W256 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Text
T.pack ([Char] -> Text)
-> (Map W256 W256 -> [Char]) -> Map 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)] -> [Char])
-> (Map W256 W256 -> [(W256, W256)]) -> Map W256 W256 -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map W256 W256 -> [(W256, W256)]
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 (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
")"
        , Expr 'Buf -> 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 (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
")"
        , Expr 'Buf -> 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 (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
")"
        , Expr 'Buf -> 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 (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
$ Int -> ByteString -> [Char]
prettyHex Int
0 ByteString
bs
          , Text
")"
          ]


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

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

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

strip0x' :: String -> String
strip0x' :: ShowS
strip0x' [Char]
s = if [Char]
"0x" [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)