module EVM.Debug where

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

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
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
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
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
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 (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
    [ (String -> Doc
text String
"codesize", Int -> Doc
int (Buffer -> Int
len (Contract
c Contract -> Getting Buffer Contract Buffer -> Buffer
forall s a. s -> Getting a s a -> a
^. Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode)))
    , (String -> Doc
text String
"codehash", String -> Doc
text (W256 -> String
forall a. Show a => a -> String
show (Contract
c Contract -> Getting W256 Contract W256 -> W256
forall s a. s -> Getting a s a -> a
^. Getting W256 Contract W256
Lens' Contract W256
codehash)))
    , (String -> Doc
text String
"balance", Int -> Doc
int (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Contract
c Contract -> Getting Word Contract Word -> Word
forall s a. s -> Getting a s a -> a
^. Getting Word Contract Word
Lens' Contract Word
balance)))
    , (String -> Doc
text String
"nonce", Int -> Doc
int (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Contract
c Contract -> Getting Word Contract Word -> Word
forall s a. s -> Getting a s a -> a
^. Getting Word Contract Word
Lens' Contract Word
nonce)))
    , (String -> Doc
text String
"storage", String -> Doc
text (Storage -> String
forall a. Show a => a -> String
show (Contract
c Contract -> Getting Storage Contract Storage -> Storage
forall s a. s -> Getting a s a -> a
^. Getting Storage Contract Storage
Lens' Contract Storage
storage)))
    ]

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) -> (String -> Doc
text (Addr -> String
forall a. Show a => a -> String
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))

-- debugger :: Maybe SourceCache -> VM -> IO VM
-- debugger maybeCache vm = do
--   -- cpprint (view state vm)
--   cpprint ("pc" :: Text, view (state . pc) vm)
--   cpprint (view (state . stack) vm)
--   -- cpprint (view logs vm)
--   cpprint (vmOp vm)
--   cpprint (opParams vm)
--   cpprint (length (view frames vm))

--   -- putDoc (prettyContracts (view (env . contracts) vm))

--   case maybeCache of
--     Nothing ->
--       return ()
--     Just cache ->
--       case currentSrcMap vm of
--         Nothing -> cpprint ("no srcmap" :: Text)
--         Just sm -> cpprint (srcMapCode cache sm)

--   if vm ^. result /= Nothing
--     then do
--       print (vm ^. result)
--       return vm
--     else
--     -- readline "(evm) " >>=
--     return (Just "") >>=
--       \case
--         Nothing ->
--           return vm
--         Just cmdline ->
--           case words cmdline of
--             [] ->
--               debugger maybeCache (execState exec1 vm)

--             ["block"] ->
--               do cpprint (view block vm)
--                  debugger maybeCache vm

--             ["storage"] ->
--               do cpprint (view (env . contracts) vm)
--                  debugger maybeCache vm

--             ["contracts"] ->
--               do putDoc (prettyContracts (view (env . contracts) vm))
--                  debugger maybeCache vm

--             -- ["disassemble"] ->
--             --   do cpprint (mkCodeOps (view (state . code) vm))
--             --      debugger maybeCache vm

--             _  -> debugger maybeCache vm

-- lookupSolc :: VM -> W256 -> Maybe SolcContract
-- lookupSolc vm hash =
--   case vm ^? env . solcByRuntimeHash . ix hash of
--     Just x -> Just x
--     Nothing ->
--       vm ^? env . solcByCreationHash . ix hash

srcMapCodePos :: SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos :: SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos SourceCache
cache SrcMap
sm =
  ((Text, ByteString) -> (Text, Int))
-> Maybe (Text, ByteString) -> Maybe (Text, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Int) -> (Text, ByteString) -> (Text, Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Int
f) (Maybe (Text, ByteString) -> Maybe (Text, Int))
-> Maybe (Text, ByteString) -> Maybe (Text, Int)
forall a b. (a -> b) -> a -> b
$ SourceCache
cache SourceCache
-> Getting
     (First (Text, ByteString)) SourceCache (Text, ByteString)
-> Maybe (Text, ByteString)
forall s a. s -> Getting (First a) s a -> Maybe a
^? ([(Text, ByteString)]
 -> Const (First (Text, ByteString)) [(Text, ByteString)])
-> SourceCache -> Const (First (Text, ByteString)) SourceCache
Lens' SourceCache [(Text, ByteString)]
sourceFiles (([(Text, ByteString)]
  -> Const (First (Text, ByteString)) [(Text, ByteString)])
 -> SourceCache -> Const (First (Text, ByteString)) SourceCache)
-> (((Text, ByteString)
     -> Const (First (Text, ByteString)) (Text, ByteString))
    -> [(Text, ByteString)]
    -> Const (First (Text, ByteString)) [(Text, ByteString)])
-> Getting
     (First (Text, ByteString)) SourceCache (Text, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [(Text, ByteString)]
-> Traversal' [(Text, ByteString)] (IxValue [(Text, ByteString)])
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) 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 =
  ((Text, ByteString) -> ByteString)
-> Maybe (Text, ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ByteString) -> ByteString
f (Maybe (Text, ByteString) -> Maybe ByteString)
-> Maybe (Text, ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SourceCache
cache SourceCache
-> Getting
     (First (Text, ByteString)) SourceCache (Text, ByteString)
-> Maybe (Text, ByteString)
forall s a. s -> Getting (First a) s a -> Maybe a
^? ([(Text, ByteString)]
 -> Const (First (Text, ByteString)) [(Text, ByteString)])
-> SourceCache -> Const (First (Text, ByteString)) SourceCache
Lens' SourceCache [(Text, ByteString)]
sourceFiles (([(Text, ByteString)]
  -> Const (First (Text, ByteString)) [(Text, ByteString)])
 -> SourceCache -> Const (First (Text, ByteString)) SourceCache)
-> (((Text, ByteString)
     -> Const (First (Text, ByteString)) (Text, ByteString))
    -> [(Text, ByteString)]
    -> Const (First (Text, ByteString)) [(Text, ByteString)])
-> Getting
     (First (Text, ByteString)) SourceCache (Text, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [(Text, ByteString)]
-> Traversal' [(Text, ByteString)] (IxValue [(Text, ByteString)])
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 (Int -> Int -> Int
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)