module EVM.Debug where

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

import Control.Arrow (second)
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.Map (Map)
import Data.Map qualified as Map
import Optics.Core
import Text.PrettyPrint.ANSI.Leijen
import Witch (unsafeInto)

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

object :: [(Doc, Doc)] -> Doc
object :: [(Doc, Doc)] -> Doc
object [(Doc, Doc)]
xs =
  Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
lbrace
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
    Doc -> Doc -> Doc
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]))
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line
    Doc -> Doc -> Doc
forall a. 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 (FilePath -> Doc)
-> (Expr 'EWord -> FilePath) -> Expr 'EWord -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> FilePath
forall a. Show a => a -> FilePath
show (Expr 'EWord -> Doc) -> Expr 'EWord -> Doc
forall a b. (a -> b) -> a -> b
$ (Expr 'Buf -> Expr 'EWord
bufLength (Contract
c Contract -> Optic' A_Getter NoIx Contract (Expr 'Buf) -> Expr 'Buf
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Getter NoIx Contract (Expr 'Buf)
bytecode)))
    , (FilePath -> Doc
text FilePath
"codehash", FilePath -> Doc
text (Expr 'EWord -> FilePath
forall a. Show a => a -> FilePath
show Contract
c.codehash))
    , (FilePath -> Doc
text FilePath
"balance", Int -> Doc
int (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Contract
c.balance))
    , (FilePath -> Doc
text FilePath
"nonce", Int -> Doc
int (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Contract
c.nonce))
    ]

prettyContracts :: Map Addr Contract -> Doc
prettyContracts :: Map Addr Contract -> Doc
prettyContracts Map Addr Contract
x =
  [(Doc, Doc)] -> Doc
object
    (((Addr, Contract) -> (Doc, Doc))
-> [(Addr, Contract)] -> [(Doc, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Addr
a, Contract
b) -> (FilePath -> Doc
text (Addr -> FilePath
forall a. Show a => a -> FilePath
show Addr
a), Contract -> Doc
prettyContract Contract
b))
     (Map Addr Contract -> [(Addr, Contract)]
forall k a. 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 =
  ((FilePath, ByteString) -> (FilePath, Int))
-> Maybe (FilePath, ByteString) -> Maybe (FilePath, Int)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Int) -> (FilePath, ByteString) -> (FilePath, Int)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Int
f) (Maybe (FilePath, ByteString) -> Maybe (FilePath, Int))
-> Maybe (FilePath, ByteString) -> Maybe (FilePath, Int)
forall a b. (a -> b) -> a -> b
$ SourceCache
cache.files Map Int (FilePath, ByteString)
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (FilePath, ByteString)
-> Maybe (FilePath, ByteString)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Index (Map Int (FilePath, ByteString))
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (IxValue (Map Int (FilePath, ByteString)))
forall m. 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) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode SourceCache
cache SrcMap
sm =
  ((FilePath, ByteString) -> ByteString)
-> Maybe (FilePath, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, ByteString) -> ByteString
f (Maybe (FilePath, ByteString) -> Maybe ByteString)
-> Maybe (FilePath, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SourceCache
cache.files Map Int (FilePath, ByteString)
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (FilePath, ByteString)
-> Maybe (FilePath, ByteString)
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Index (Map Int (FilePath, ByteString))
-> Optic'
     (IxKind (Map Int (FilePath, ByteString)))
     NoIx
     (Map Int (FilePath, ByteString))
     (IxValue (Map Int (FilePath, ByteString)))
forall m. 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 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
80 SrcMap
sm.length) (Int -> ByteString -> ByteString
ByteString.drop SrcMap
sm.offset ByteString
v)