module EVM.Exec where

import EVM
import EVM.Concrete (createAddress)
import EVM.Symbolic (litAddr)
import EVM.Types

import qualified EVM.FeeSchedule as FeeSchedule

import Control.Lens
import Control.Monad.State.Class (MonadState)
import Control.Monad.State.Strict (runState)
import Data.ByteString (ByteString)
import Data.Maybe (isNothing)

import qualified Control.Monad.State.Class as State

ethrunAddress :: Addr
ethrunAddress :: Addr
ethrunAddress = Word160 -> Addr
Addr 0x00a329c0648769a73afac7f9381e08fb43dbea72

vmForEthrunCreation :: ByteString -> VM
vmForEthrunCreation :: ByteString -> VM
vmForEthrunCreation creationCode :: ByteString
creationCode =
  (VMOpts -> VM
makeVm (VMOpts -> VM) -> VMOpts -> VM
forall a b. (a -> b) -> a -> b
$ $WVMOpts :: Contract
-> (Buffer, SymWord)
-> SymWord
-> Addr
-> SAddr
-> Addr
-> W256
-> W256
-> W256
-> SymWord
-> Addr
-> W256
-> W256
-> W256
-> W256
-> FeeSchedule Integer
-> W256
-> Bool
-> StorageModel
-> Map Addr [W256]
-> VMOpts
VMOpts
    { vmoptContract :: Contract
vmoptContract = ContractCode -> Contract
initialContract (Buffer -> ContractCode
InitCode (ByteString -> Buffer
ConcreteBuffer ByteString
creationCode))
    , vmoptCalldata :: (Buffer, SymWord)
vmoptCalldata = (Buffer
forall a. Monoid a => a
mempty, 0)
    , vmoptValue :: SymWord
vmoptValue = 0
    , vmoptAddress :: Addr
vmoptAddress = Addr -> W256 -> Addr
createAddress Addr
ethrunAddress 1
    , vmoptCaller :: SAddr
vmoptCaller = Addr -> SAddr
litAddr Addr
ethrunAddress
    , vmoptOrigin :: Addr
vmoptOrigin = Addr
ethrunAddress
    , vmoptCoinbase :: Addr
vmoptCoinbase = 0
    , vmoptNumber :: W256
vmoptNumber = 0
    , vmoptTimestamp :: SymWord
vmoptTimestamp = 0
    , vmoptBlockGaslimit :: W256
vmoptBlockGaslimit = 0
    , vmoptGasprice :: W256
vmoptGasprice = 0
    , vmoptDifficulty :: W256
vmoptDifficulty = 0
    , vmoptGas :: W256
vmoptGas = 0xffffffffffffffff
    , vmoptGaslimit :: W256
vmoptGaslimit = 0xffffffffffffffff
    , vmoptMaxCodeSize :: W256
vmoptMaxCodeSize = 0xffffffff
    , vmoptSchedule :: FeeSchedule Integer
vmoptSchedule = FeeSchedule Integer
forall n. Num n => FeeSchedule n
FeeSchedule.berlin
    , vmoptChainId :: W256
vmoptChainId = 1
    , vmoptCreate :: Bool
vmoptCreate = Bool
False
    , vmoptStorageModel :: StorageModel
vmoptStorageModel = StorageModel
ConcreteS
    , vmoptTxAccessList :: Map Addr [W256]
vmoptTxAccessList = Map Addr [W256]
forall a. Monoid a => a
mempty
    }) VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
ethrunAddress)
             (Contract -> Maybe Contract
forall a. a -> Maybe a
Just (ContractCode -> Contract
initialContract (Buffer -> ContractCode
RuntimeCode Buffer
forall a. Monoid a => a
mempty)))

exec :: MonadState VM m => m VMResult
exec :: m VMResult
exec =
  Getting (Maybe VMResult) VM (Maybe VMResult) -> m (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe VMResult) VM (Maybe VMResult)
Lens' VM (Maybe VMResult)
EVM.result m (Maybe VMResult) -> (Maybe VMResult -> m VMResult) -> m VMResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nothing -> (VM -> ((), VM)) -> m ()
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (State VM () -> VM -> ((), VM)
forall s a. State s a -> s -> (a, s)
runState State VM ()
exec1) m () -> m VMResult -> m VMResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m VMResult
forall (m :: * -> *). MonadState VM m => m VMResult
exec
    Just x :: VMResult
x  -> VMResult -> m VMResult
forall (m :: * -> *) a. Monad m => a -> m a
return VMResult
x

run :: MonadState VM m => m VM
run :: m VM
run =
  Getting (Maybe VMResult) VM (Maybe VMResult) -> m (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe VMResult) VM (Maybe VMResult)
Lens' VM (Maybe VMResult)
EVM.result m (Maybe VMResult) -> (Maybe VMResult -> m VM) -> m VM
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nothing -> (VM -> ((), VM)) -> m ()
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (State VM () -> VM -> ((), VM)
forall s a. State s a -> s -> (a, s)
runState State VM ()
exec1) m () -> m VM -> m VM
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m VM
forall (m :: * -> *). MonadState VM m => m VM
run
    Just _  -> m VM
forall s (m :: * -> *). MonadState s m => m s
State.get

execWhile :: MonadState VM m => (VM -> Bool) -> m Int
execWhile :: (VM -> Bool) -> m Int
execWhile p :: VM -> Bool
p = Int -> m Int
go 0
  where
    go :: Int -> m Int
go i :: Int
i = do
      VM
x <- m VM
forall s (m :: * -> *). MonadState s m => m s
State.get
      if VM -> Bool
p VM
x Bool -> Bool -> Bool
&& Maybe VMResult -> Bool
forall a. Maybe a -> Bool
isNothing (Getting (Maybe VMResult) VM (Maybe VMResult)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe VMResult) VM (Maybe VMResult)
Lens' VM (Maybe VMResult)
result VM
x)
        then do
          (VM -> ((), VM)) -> m ()
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (State VM () -> VM -> ((), VM)
forall s a. State s a -> s -> (a, s)
runState State VM ()
exec1)
          Int -> m Int
go (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
      else
        Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- locateBreakpoint :: UIState -> Text -> Int -> Maybe [(Word256, Vector Bool)]
-- locateBreakpoint ui fileName lineNo = do
--   (i, (t, s)) <-
--     flip find (Map.toList (ui ^. uiSourceCache . sourceFiles))
--       (\(_, (t, _)) -> t == fileName)
--   let ls = BS.split 0x0a s
--       l = ls !! (lineNo - 1)
--       offset = 1 + sum (map ((+ 1) . BS.length) (take (lineNo - 1) ls))
--       horizon = offset + BS.length l
--   return $ Map.elems (ui ^. uiVm . _Just . env . solc)
--     & map (\c -> (
--         c ^. solcCodehash,
--         Vector.create $ new (Seq.length (c ^. solcSrcmap)) >>= \v -> do
--           fst $ foldl' (\(!m, !j) (sm@SM { srcMapOffset = o }) ->
--             if srcMapFile sm == i && o >= offset && o < horizon
--             then (m >> write v j True, j + 1)
--             else (m >> write v j False, j + 1)) (return (), 0) (c ^. solcSrcmap)
--           return v
--       ))