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