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