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