module EVM.Debug where

import EVM          (Contract, nonce, balance, bytecode, codehash)
import EVM.Solidity (SrcMap, srcMapFile, srcMapOffset, srcMapLength, SourceCache, sourceFiles)
import EVM.Types    (Addr)
import EVM.Expr     (bufLength)

import Control.Arrow   (second)
import Control.Lens
import Data.ByteString (ByteString)
import Data.Map        (Map)
import Data.Text       (Text)

import qualified Data.ByteString       as ByteString
import qualified Data.Map              as Map

import Text.PrettyPrint.ANSI.Leijen

data Mode = Debug | Run | JsonTrace deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

object :: [(Doc, Doc)] -> Doc
object :: [(Doc, Doc)] -> Doc
object [(Doc, Doc)]
xs =
  Doc -> Doc
group forall a b. (a -> b) -> a -> b
$ Doc
lbrace
    forall a. Semigroup a => a -> a -> a
<> Doc
line
    forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
indent Int
2 ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
';') [Doc
k Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
v | (Doc
k, Doc
v) <- [(Doc, Doc)]
xs]))
    forall a. Semigroup a => a -> a -> a
<> Doc
line
    forall a. Semigroup a => a -> a -> a
<> Doc
rbrace

prettyContract :: Contract -> Doc
prettyContract :: Contract -> Doc
prettyContract Contract
c =
  [(Doc, Doc)] -> Doc
object
    [ (String -> Doc
text String
"codesize", String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ (Expr 'Buf -> Expr 'EWord
bufLength (Contract
c forall s a. s -> Getting a s a -> a
^. Getter Contract (Expr 'Buf)
bytecode)))
    , (String -> Doc
text String
"codehash", String -> Doc
text (forall a. Show a => a -> String
show (Contract
c forall s a. s -> Getting a s a -> a
^. Lens' Contract (Expr 'EWord)
codehash)))
    , (String -> Doc
text String
"balance", Int -> Doc
int (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Contract
c forall s a. s -> Getting a s a -> a
^. Lens' Contract W256
balance)))
    , (String -> Doc
text String
"nonce", Int -> Doc
int (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Contract
c forall s a. s -> Getting a s a -> a
^. Lens' Contract W256
nonce)))
    ]

prettyContracts :: Map Addr Contract -> Doc
prettyContracts :: Map Addr Contract -> Doc
prettyContracts Map Addr Contract
x =
  [(Doc, Doc)] -> Doc
object
    (forall a b. (a -> b) -> [a] -> [b]
map (\(Addr
a, Contract
b) -> (String -> Doc
text (forall a. Show a => a -> String
show Addr
a), Contract -> Doc
prettyContract Contract
b))
     (forall k a. Map k a -> [(k, a)]
Map.toList Map Addr Contract
x))

srcMapCodePos :: SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos :: SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos SourceCache
cache SrcMap
sm =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Int
f) forall a b. (a -> b) -> a -> b
$ SourceCache
cache forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' SourceCache [(Text, ByteString)]
sourceFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
sm)
  where
    f :: ByteString -> Int
f ByteString
v = Word8 -> ByteString -> Int
ByteString.count Word8
0xa (Int -> ByteString -> ByteString
ByteString.take (SrcMap -> Int
srcMapOffset SrcMap
sm forall a. Num a => a -> a -> a
- Int
1) ByteString
v) forall a. Num a => a -> a -> a
+ Int
1

srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode SourceCache
cache SrcMap
sm =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ByteString) -> ByteString
f forall a b. (a -> b) -> a -> b
$ SourceCache
cache forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' SourceCache [(Text, ByteString)]
sourceFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
sm)
  where
    f :: (Text, ByteString) -> ByteString
f (Text
_, ByteString
v) = Int -> ByteString -> ByteString
ByteString.take (forall a. Ord a => a -> a -> a
min Int
80 (SrcMap -> Int
srcMapLength SrcMap
sm)) (Int -> ByteString -> ByteString
ByteString.drop (SrcMap -> Int
srcMapOffset SrcMap
sm) ByteString
v)