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 xs :: [(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 2 ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char ';') [Doc
k Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
v | (k :: Doc
k, v :: 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 c :: Contract
c =
  [(Doc, Doc)] -> Doc
object
    [ (String -> Doc
text "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 "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 "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 "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 "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 x :: Map Addr Contract
x =
  [(Doc, Doc)] -> Doc
object
    (((Addr, Contract) -> (Doc, Doc))
-> [(Addr, Contract)] -> [(Doc, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Addr
a, b :: 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 cache :: SourceCache
cache sm :: 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
^? (Map Int (Text, ByteString)
 -> Const (First (Text, ByteString)) (Map Int (Text, ByteString)))
-> SourceCache -> Const (First (Text, ByteString)) SourceCache
Lens' SourceCache (Map Int (Text, ByteString))
sourceFiles ((Map Int (Text, ByteString)
  -> Const (First (Text, ByteString)) (Map Int (Text, ByteString)))
 -> SourceCache -> Const (First (Text, ByteString)) SourceCache)
-> (((Text, ByteString)
     -> Const (First (Text, ByteString)) (Text, ByteString))
    -> Map Int (Text, ByteString)
    -> Const (First (Text, ByteString)) (Map Int (Text, ByteString)))
-> Getting
     (First (Text, ByteString)) SourceCache (Text, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Int (Text, ByteString))
-> Traversal'
     (Map Int (Text, ByteString)) (IxValue (Map Int (Text, ByteString)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
sm)
  where
    f :: ByteString -> Int
f v :: ByteString
v = Word8 -> ByteString -> Int
ByteString.count 0xa (Int -> ByteString -> ByteString
ByteString.take (SrcMap -> Int
srcMapOffset SrcMap
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ByteString
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
srcMapCode cache :: SourceCache
cache sm :: 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
^? (Map Int (Text, ByteString)
 -> Const (First (Text, ByteString)) (Map Int (Text, ByteString)))
-> SourceCache -> Const (First (Text, ByteString)) SourceCache
Lens' SourceCache (Map Int (Text, ByteString))
sourceFiles ((Map Int (Text, ByteString)
  -> Const (First (Text, ByteString)) (Map Int (Text, ByteString)))
 -> SourceCache -> Const (First (Text, ByteString)) SourceCache)
-> (((Text, ByteString)
     -> Const (First (Text, ByteString)) (Text, ByteString))
    -> Map Int (Text, ByteString)
    -> Const (First (Text, ByteString)) (Map Int (Text, ByteString)))
-> Getting
     (First (Text, ByteString)) SourceCache (Text, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Int (Text, ByteString))
-> Traversal'
     (Map Int (Text, ByteString)) (IxValue (Map Int (Text, ByteString)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (SrcMap -> Int
srcMapFile SrcMap
sm)
  where
    f :: (Text, ByteString) -> ByteString
f (_, v :: ByteString
v) = Int -> ByteString -> ByteString
ByteString.take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 80 (SrcMap -> Int
srcMapLength SrcMap
sm)) (Int -> ByteString -> ByteString
ByteString.drop (SrcMap -> Int
srcMapOffset SrcMap
sm) ByteString
v)