module EVM.Exec where

import EVM hiding (createAddress)
import EVM.Concrete (createAddress)
import EVM.FeeSchedule (feeSchedule)
import EVM.Types

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

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

vmForEthrunCreation :: VMOps t => ByteString -> ST s (VM t s)
vmForEthrunCreation :: forall (t :: VMType) s. VMOps t => ByteString -> ST s (VM t s)
vmForEthrunCreation ByteString
creationCode =
  (VMOpts t -> ST s (VM t s)
forall (t :: VMType) s. VMOps t => VMOpts t -> ST s (VM t s)
makeVm (VMOpts t -> ST s (VM t s)) -> VMOpts t -> ST s (VM t s)
forall a 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. Monoid a => a
mempty)
    , $sel:otherContracts:VMOpts :: [(Expr 'EAddr, Contract)]
otherContracts = []
    , $sel:calldata:VMOpts :: (Expr 'Buf, [Prop])
calldata = (Expr 'Buf, [Prop])
forall a. Monoid a => a
mempty
    , $sel:value:VMOpts :: Expr 'EWord
value = W256 -> Expr 'EWord
Lit W256
0
    , $sel:baseState:VMOpts :: BaseState
baseState = BaseState
EmptyBase
    , $sel:address:VMOpts :: Expr 'EAddr
address = Addr -> W64 -> Expr 'EAddr
createAddress Addr
ethrunAddress W64
1
    , $sel:caller:VMOpts :: Expr 'EAddr
caller = Addr -> Expr 'EAddr
LitAddr Addr
ethrunAddress
    , $sel:origin:VMOpts :: Expr 'EAddr
origin = Addr -> Expr 'EAddr
LitAddr Addr
ethrunAddress
    , $sel:coinbase:VMOpts :: Expr 'EAddr
coinbase = Addr -> Expr 'EAddr
LitAddr 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 :: Gas t
gas = Word64 -> Gas t
forall (t :: VMType). VMOps t => Word64 -> Gas t
toGas 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. Num n => FeeSchedule n
feeSchedule
    , $sel:chainId:VMOpts :: W256
chainId = W256
1
    , $sel:create:VMOpts :: Bool
create = Bool
False
    , $sel:txAccessList:VMOpts :: Map (Expr 'EAddr) [W256]
txAccessList = Map (Expr 'EAddr) [W256]
forall a. Monoid a => a
mempty
    , $sel:allowFFI:VMOpts :: Bool
allowFFI = Bool
False
    }) ST s (VM t s) -> (VM t s -> VM t s) -> ST s (VM t s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Optic
  A_Lens
  NoIx
  (VM t s)
  (VM t s)
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
  (Maybe Contract)
-> Maybe Contract -> VM t s -> VM t s
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx (VM t s) (VM t s) Env Env
#env Optic A_Lens NoIx (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     NoIx
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     NoIx
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(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 (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  NoIx
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     NoIx
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     (VM t s)
     (VM t s)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(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 (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Addr -> Expr 'EAddr
LitAddr Addr
ethrunAddress))
             (Contract -> Maybe Contract
forall a. a -> Maybe a
Just (ContractCode -> Contract
initialContract (RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
""))))

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

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

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