module EVM.Exec where

import EVM
import EVM.Concrete (createAddress)
import EVM.FeeSchedule qualified as FeeSchedule
import EVM.Expr (litAddr)
import EVM.Types

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

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 :: OpticKind) b. (a -> b) -> a -> b
$ VMOpts
    { $sel:contract:VMOpts :: Contract
contract = ContractCode -> Contract
initialContract (ByteString -> Expr 'Buf -> ContractCode
InitCode ByteString
creationCode Expr 'Buf
forall (a :: OpticKind). Monoid a => a
mempty)
    , $sel:calldata:VMOpts :: (Expr 'Buf, [Prop])
calldata = (Expr 'Buf, [Prop])
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 = FeeSchedule Word64
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 = Map Addr [W256]
forall (a :: OpticKind). Monoid a => a
mempty
    , $sel:allowFFI:VMOpts :: Bool
allowFFI = Bool
False
    }) VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> VM -> VM
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 (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
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
% Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
ethrunAddress)
             (Contract -> Maybe Contract
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 <- StateT VM Identity VM
forall (m :: OpticKind -> OpticKind) (s :: OpticKind).
Monad m =>
StateT s m s
get
  case VM
vm.result of
    Maybe VMResult
Nothing -> EVM ()
exec1 EVM () -> State VM VMResult -> State VM VMResult
forall (a :: OpticKind) (b :: OpticKind).
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> State VM VMResult
exec
    Just VMResult
r -> VMResult -> State VM VMResult
forall (a :: OpticKind). a -> StateT VM Identity a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure VMResult
r

run :: State VM VM
run :: StateT VM Identity VM
run = do
  VM
vm <- StateT VM Identity VM
forall (m :: OpticKind -> OpticKind) (s :: OpticKind).
Monad m =>
StateT s m s
get
  case VM
vm.result of
    Maybe VMResult
Nothing -> EVM ()
exec1 EVM () -> StateT VM Identity VM -> StateT VM Identity VM
forall (a :: OpticKind) (b :: OpticKind).
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> StateT VM Identity VM
run
    Just VMResult
_ -> VM -> StateT VM Identity VM
forall (a :: OpticKind). a -> StateT VM Identity a
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 <- StateT VM Identity VM
forall (m :: OpticKind -> OpticKind) (s :: OpticKind).
Monad m =>
StateT s m s
get
      if VM -> Bool
p VM
vm Bool -> Bool -> Bool
&& Maybe VMResult -> Bool
forall (a :: OpticKind). Maybe a -> Bool
isNothing VM
vm.result
        then do
          Int -> State VM Int
go (Int -> State VM Int) -> Int -> State VM Int
forall (a :: OpticKind) b. (a -> b) -> a -> b
$! (Int
i Int -> Int -> Int
forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1)
      else
        Int -> State VM Int
forall (a :: OpticKind). a -> StateT VM Identity a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Int
i