module EVM.Exec where

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

import qualified EVM.FeeSchedule as FeeSchedule

import Optics.Core
import Control.Monad.Trans.State.Strict (get, State)
import Data.ByteString (ByteString)
import Data.Maybe (isNothing)


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

vmForEthrunCreation :: ByteString -> VM
vmForEthrunCreation :: ByteString -> VM
vmForEthrunCreation ByteString
creationCode =
  (VMOpts -> VM
makeVm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ VMOpts
    { $sel:contract:VMOpts :: Contract
contract = ContractCode -> Contract
initialContract (ByteString -> Expr 'Buf -> ContractCode
InitCode ByteString
creationCode forall (a :: OpticKind). Monoid a => a
mempty)
    , $sel:calldata:VMOpts :: (Expr 'Buf, [Prop])
calldata = forall (a :: OpticKind). Monoid a => a
mempty
    , $sel:value:VMOpts :: Expr 'EWord
value = (W256 -> Expr 'EWord
Lit W256
0)
    , $sel:initialStorage:VMOpts :: Expr 'Storage
initialStorage = Expr 'Storage
EmptyStore
    , $sel:address:VMOpts :: Addr
address = Addr -> W256 -> Addr
createAddress Addr
ethrunAddress W256
1
    , $sel:caller:VMOpts :: Expr 'EWord
caller = Addr -> Expr 'EWord
litAddr Addr
ethrunAddress
    , $sel:origin:VMOpts :: Addr
origin = Addr
ethrunAddress
    , $sel:coinbase:VMOpts :: Addr
coinbase = Addr
0
    , $sel:number:VMOpts :: W256
number = W256
0
    , $sel:timestamp:VMOpts :: Expr 'EWord
timestamp = (W256 -> Expr 'EWord
Lit W256
0)
    , $sel:blockGaslimit:VMOpts :: Word64
blockGaslimit = Word64
0
    , $sel:gasprice:VMOpts :: W256
gasprice = W256
0
    , $sel:prevRandao:VMOpts :: W256
prevRandao = W256
42069
    , $sel:gas:VMOpts :: Word64
gas = Word64
0xffffffffffffffff
    , $sel:gaslimit:VMOpts :: Word64
gaslimit = Word64
0xffffffffffffffff
    , $sel:baseFee:VMOpts :: W256
baseFee = W256
0
    , $sel:priorityFee:VMOpts :: W256
priorityFee = W256
0
    , $sel:maxCodeSize:VMOpts :: W256
maxCodeSize = W256
0xffffffff
    , $sel:schedule:VMOpts :: FeeSchedule Word64
schedule = forall (n :: OpticKind). Num n => FeeSchedule n
FeeSchedule.berlin
    , $sel:chainId:VMOpts :: W256
chainId = W256
1
    , $sel:create:VMOpts :: Bool
create = Bool
False
    , $sel:txAccessList:VMOpts :: Map Addr [W256]
txAccessList = forall (a :: OpticKind). Monoid a => a
mempty
    , $sel:allowFFI:VMOpts :: Bool
allowFFI = Bool
False
    }) forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
ethrunAddress)
             (forall (a :: OpticKind). a -> Maybe a
Just (ContractCode -> Contract
initialContract (RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
""))))

exec :: State VM VMResult
exec :: State VM VMResult
exec = do
  VM
vm <- forall (m :: OpticKind -> OpticKind) (s :: OpticKind).
Monad m =>
StateT s m s
get
  case VM
vm.result of
    Maybe VMResult
Nothing -> EVM ()
exec1 forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> State VM VMResult
exec
    Just VMResult
r -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure VMResult
r

run :: State VM VM
run :: State VM VM
run = do
  VM
vm <- forall (m :: OpticKind -> OpticKind) (s :: OpticKind).
Monad m =>
StateT s m s
get
  case VM
vm.result of
    Maybe VMResult
Nothing -> EVM ()
exec1 forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> State VM VM
run
    Just VMResult
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure VM
vm

execWhile :: (VM -> Bool) -> State VM Int
execWhile :: (VM -> Bool) -> State VM Int
execWhile VM -> Bool
p = Int -> State VM Int
go Int
0
  where
    go :: Int -> State VM Int
go Int
i = do
      VM
vm <- forall (m :: OpticKind -> OpticKind) (s :: OpticKind).
Monad m =>
StateT s m s
get
      if VM -> Bool
p VM
vm Bool -> Bool -> Bool
&& forall (a :: OpticKind). Maybe a -> Bool
isNothing VM
vm.result
        then do
          Int -> State VM Int
go forall (a :: OpticKind) b. (a -> b) -> a -> b
$! (Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1)
      else
        forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Int
i