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 Word160
0x00a329c0648769a73afac7f9381e08fb43dbea72

vmForEthrunCreation :: ByteString -> VM
vmForEthrunCreation :: ByteString -> VM
vmForEthrunCreation ByteString
creationCode =
  (VMOpts -> VM
makeVm (VMOpts -> VM) -> VMOpts -> VM
forall a b. (a -> b) -> a -> b
$ VMOpts :: Contract
-> (Buffer, SymWord)
-> SymWord
-> W256
-> Addr
-> SAddr
-> Addr
-> W256
-> W256
-> W256
-> SymWord
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> FeeSchedule Integer
-> W256
-> Bool
-> StorageModel
-> Map Addr [W256]
-> Bool
-> 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, SymWord
0)
    , vmoptValue :: SymWord
vmoptValue = SymWord
0
    , vmoptAddress :: Addr
vmoptAddress = Addr -> W256 -> Addr
createAddress Addr
ethrunAddress W256
1
    , vmoptCaller :: SAddr
vmoptCaller = Addr -> SAddr
litAddr Addr
ethrunAddress
    , vmoptOrigin :: Addr
vmoptOrigin = Addr
ethrunAddress
    , vmoptCoinbase :: Addr
vmoptCoinbase = Addr
0
    , vmoptNumber :: W256
vmoptNumber = W256
0
    , vmoptTimestamp :: SymWord
vmoptTimestamp = SymWord
0
    , vmoptBlockGaslimit :: W256
vmoptBlockGaslimit = W256
0
    , vmoptGasprice :: W256
vmoptGasprice = W256
0
    , vmoptDifficulty :: W256
vmoptDifficulty = W256
0
    , vmoptGas :: W256
vmoptGas = W256
0xffffffffffffffff
    , vmoptGaslimit :: W256
vmoptGaslimit = W256
0xffffffffffffffff
    , vmoptBaseFee :: W256
vmoptBaseFee = W256
0
    , vmoptPriorityFee :: W256
vmoptPriorityFee = W256
0
    , vmoptMaxCodeSize :: W256
vmoptMaxCodeSize = W256
0xffffffff
    , vmoptSchedule :: FeeSchedule Integer
vmoptSchedule = FeeSchedule Integer
forall n. Num n => FeeSchedule n
FeeSchedule.berlin
    , vmoptChainId :: W256
vmoptChainId = W256
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
    , vmoptAllowFFI :: Bool
vmoptAllowFFI = Bool
False
    }) 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
    Maybe VMResult
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 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
    Maybe VMResult
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 VMResult
_  -> 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 VM -> Bool
p = Int -> m Int
go Int
0
  where
    go :: Int -> m Int
go 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
+ Int
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
--       ))