{-# Language DataKinds #-}

module EVM.Debug where

import EVM          (bytecode)
import EVM.Solidity (SrcMap(..), SourceCache(..))
import EVM.Types    (Contract, Addr)
import EVM.Expr     (bufLength)

import Control.Arrow   (second)
import Optics.Core
import Data.ByteString (ByteString)
import Data.Map        (Map)

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 :: OpticKind).
(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 -> FilePath
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> FilePath
$cshow :: Mode -> FilePath
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 :: OpticKind) b. (a -> b) -> a -> b
$ Doc
lbrace
    forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Doc
line
    forall (a :: OpticKind). 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 :: OpticKind). Semigroup a => a -> a -> a
<> Doc
line
    forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Doc
rbrace

prettyContract :: Contract -> Doc
prettyContract :: Contract -> Doc
prettyContract Contract
c =
  [(Doc, Doc)] -> Doc
object
    [ (FilePath -> Doc
text FilePath
"codesize", FilePath -> Doc
text forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> FilePath
show forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Expr 'Buf -> Expr 'EWord
bufLength (Contract
c forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Getter Contract (Expr 'Buf)
bytecode)))
    , (FilePath -> Doc
text FilePath
"codehash", FilePath -> Doc
text (forall (a :: OpticKind). Show a => a -> FilePath
show (Contract
c forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "codehash" a => a
#codehash)))
    , (FilePath -> Doc
text FilePath
"balance", Int -> Doc
int (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral (Contract
c forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "balance" a => a
#balance)))
    , (FilePath -> Doc
text FilePath
"nonce", Int -> Doc
int (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral (Contract
c forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce)))
    ]

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

srcMapCodePos :: SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos :: SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos SourceCache
cache SrcMap
sm =
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (forall (a :: OpticKind -> OpticKind -> OpticKind) (b :: OpticKind)
       (c :: OpticKind) (d :: OpticKind).
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Int
f) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ SourceCache
cache.files forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix SrcMap
sm.file
  where
    f :: ByteString -> Int
f ByteString
v = Word8 -> ByteString -> Int
ByteString.count Word8
0xa (Int -> ByteString -> ByteString
ByteString.take SrcMap
sm.offset ByteString
v) forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1

srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode SourceCache
cache SrcMap
sm =
  forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (FilePath, ByteString) -> ByteString
f forall (a :: OpticKind) b. (a -> b) -> a -> b
$ SourceCache
cache.files forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix SrcMap
sm.file
  where
    f :: (FilePath, ByteString) -> ByteString
f (FilePath
_, ByteString
v) = Int -> ByteString -> ByteString
ByteString.take (forall (a :: OpticKind). Ord a => a -> a -> a
min Int
80 SrcMap
sm.length) (Int -> ByteString -> ByteString
ByteString.drop SrcMap
sm.offset ByteString
v)