{-# Language GADTs #-}
{-# Language DataKinds #-}
module EVM.Stepper
( Action (..)
, Stepper
, exec
, execFully
, runFully
, wait
, ask
, evm
, entering
, enter
, interpret
)
where
import Prelude hiding (fail)
import Control.Monad.Operational (Program(..), singleton, view, ProgramViewT(..), ProgramView)
import Control.Monad.State.Strict (runState, liftIO, StateT)
import qualified Control.Monad.State.Class as State
import qualified EVM.Exec
import Control.Lens (use)
import Data.Binary.Get (runGetOrFail)
import Data.Text (Text)
import EVM.Types (Buffer)
import EVM (EVM, VM, VMResult (VMFailure, VMSuccess), Error (Query, Choose), Query, Choose)
import qualified EVM
import EVM.ABI (AbiType, AbiValue, getAbi)
import qualified EVM.Fetch as Fetch
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LazyByteString
data Action a where
Exec :: Action VMResult
Run :: Action VM
Wait :: Query -> Action ()
Ask :: Choose -> Action ()
EVM :: EVM a -> Action a
type Stepper a = Program Action a
exec :: Stepper VMResult
exec = singleton Exec
run :: Stepper VM
run = singleton Run
wait :: Query -> Stepper ()
wait = singleton . Wait
ask :: Choose -> Stepper ()
ask = singleton . Ask
evm :: EVM a -> Stepper a
evm = singleton . EVM
execFully :: Stepper (Either Error Buffer)
execFully =
exec >>= \case
VMFailure (Query q) ->
wait q >> execFully
VMFailure (Choose q) ->
ask q >> execFully
VMFailure x ->
pure (Left x)
VMSuccess x ->
pure (Right x)
runFully :: Stepper EVM.VM
runFully = do
vm <- run
case EVM._result vm of
Nothing -> error "should not occur"
Just (VMFailure (Query q)) ->
wait q >> runFully
Just (VMFailure (Choose q)) ->
ask q >> runFully
Just _ ->
pure vm
entering :: Text -> Stepper a -> Stepper a
entering t stepper = do
evm (EVM.pushTrace (EVM.EntryTrace t))
x <- stepper
evm EVM.popTrace
pure x
enter :: Text -> Stepper ()
enter t = evm (EVM.pushTrace (EVM.EntryTrace t))
interpret :: Fetch.Fetcher -> Stepper a -> StateT VM IO a
interpret fetcher =
eval . view
where
eval
:: ProgramView Action a
-> StateT VM IO a
eval (Return x) =
pure x
eval (action :>>= k) =
case action of
Exec ->
EVM.Exec.exec >>= interpret fetcher . k
Run ->
EVM.Exec.run >>= interpret fetcher . k
Wait q ->
do m <- liftIO (fetcher q)
State.state (runState m) >> interpret fetcher (k ())
Ask _ ->
error "cannot make choices with this interpreter"
EVM m -> do
r <- State.state (runState m)
interpret fetcher (k r)