{-# Language ImplicitParams #-}
{-# Language TemplateHaskell #-}
{-# Language DataKinds #-}
{-# Language FlexibleInstances #-}

module EVM.Emacs where

import Control.Lens
import Control.Monad.IO.Class
import Control.Monad.State.Strict hiding (state)
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.Maybe
import Data.Monoid
import Data.SCargot
import Data.SCargot.Language.HaskLike
import Data.SCargot.Repr
import Data.SCargot.Repr.Basic
import Data.Set (Set)
import Data.Text (Text, pack, unpack)
import Data.SBV hiding (Word, output)
import EVM
import EVM.ABI
import EVM.Symbolic
import EVM.Dapp
import EVM.Debug (srcMapCodePos)
import EVM.Fetch (Fetcher)
import EVM.Solidity
import EVM.Stepper (Stepper)
import EVM.TTY (currentSrcMap)
import EVM.Types
import EVM.UnitTest
import Prelude hiding (Word)
import System.Directory
import System.IO
import qualified Control.Monad.Operational as Operational
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified EVM.Fetch as Fetch
import qualified EVM.Stepper as Stepper

data UiVmState = UiVmState
  { UiVmState -> VM
_uiVm             :: VM
  , UiVmState -> Stepper ()
_uiVmNextStep     :: Stepper ()
  , UiVmState -> Maybe SolcContract
_uiVmSolc         :: Maybe SolcContract
  , UiVmState -> Maybe DappInfo
_uiVmDapp         :: Maybe DappInfo
  , UiVmState -> Int
_uiVmStepCount    :: Int
  , UiVmState -> UiVmState
_uiVmFirstState   :: UiVmState
  , UiVmState -> Fetcher
_uiVmFetcher      :: Fetcher
  , UiVmState -> Maybe Text
_uiVmMessage      :: Maybe Text
  , UiVmState -> Set W256
_uiVmSentHashes   :: Set W256
  }

makeLenses ''UiVmState

type Pred a = a -> Bool

data StepMode
  = StepOne                        -- ^ Finish after one opcode step
  | StepMany !Int                  -- ^ Run a specific number of steps
  | StepNone                       -- ^ Finish before the next opcode
  | StepUntil (Pred VM)            -- ^ Finish when a VM predicate holds

data StepOutcome a
  = Returned a                -- ^ Program finished
  | Stepped  (Stepper a)      -- ^ Took one step; more steps to go
  | Blocked  (IO (Stepper a)) -- ^ Came across blocking request

interpret
  :: StepMode
  -> Stepper a
  -> State UiVmState (StepOutcome a)
interpret :: StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
mode =
  ProgramView Action a -> State UiVmState (StepOutcome a)
forall a. ProgramView Action a -> State UiVmState (StepOutcome a)
eval (ProgramView Action a -> State UiVmState (StepOutcome a))
-> (Stepper a -> ProgramView Action a)
-> Stepper a
-> State UiVmState (StepOutcome a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stepper a -> ProgramView Action a
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
Operational.view
  where
    eval
      :: Operational.ProgramView Stepper.Action a
      -> State UiVmState (StepOutcome a)

    eval :: ProgramView Action a -> State UiVmState (StepOutcome a)
eval (Operational.Return a
x) =
      StepOutcome a -> State UiVmState (StepOutcome a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> StepOutcome a
forall a. a -> StepOutcome a
Returned a
x)

    eval (Action b
action Operational.:>>= b -> ProgramT Action Identity a
k) =
      case Action b
action of
        -- Stepper wants to keep executing?
        Action b
Stepper.Exec -> do
          let
            -- When pausing during exec, we should later restart
            -- the exec with the same continuation.
            restart :: ProgramT Action Identity a
restart = Stepper VMResult
Stepper.exec Stepper VMResult
-> (VMResult -> ProgramT Action Identity a)
-> ProgramT Action Identity a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
VMResult -> ProgramT Action Identity a
k

          case StepMode
mode of
            StepMode
StepNone ->
              -- We come here when we've continued while stepping,
              -- either from a query or from a return;
              -- we should pause here and wait for the user.
              StepOutcome a -> State UiVmState (StepOutcome a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgramT Action Identity a -> StepOutcome a
forall a. Stepper a -> StepOutcome a
Stepped (Action b -> ProgramT Action Identity b
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Operational.singleton Action b
action ProgramT Action Identity b
-> (b -> ProgramT Action Identity a) -> ProgramT Action Identity a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k))

            StepMode
StepOne -> do
              -- Run an instruction
              (UiVmState -> UiVmState) -> StateT UiVmState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify UiVmState -> UiVmState
stepOneOpcode

              Getting (Maybe VMResult) UiVmState (Maybe VMResult)
-> StateT UiVmState Identity (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((VM -> Const (Maybe VMResult) VM)
-> UiVmState -> Const (Maybe VMResult) UiVmState
Lens' UiVmState VM
uiVm ((VM -> Const (Maybe VMResult) VM)
 -> UiVmState -> Const (Maybe VMResult) UiVmState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) UiVmState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result) StateT UiVmState Identity (Maybe VMResult)
-> (Maybe VMResult -> State UiVmState (StepOutcome a))
-> State UiVmState (StepOutcome a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe VMResult
Nothing ->
                  -- If instructions remain, then pause & await user.
                  StepOutcome a -> State UiVmState (StepOutcome a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgramT Action Identity a -> StepOutcome a
forall a. Stepper a -> StepOutcome a
Stepped ProgramT Action Identity a
restart)
                Just VMResult
r ->
                  -- If returning, proceed directly the continuation,
                  -- but stopping before the next instruction.
                  StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
StepNone (b -> ProgramT Action Identity a
k b
VMResult
r)

            StepMany Int
0 ->
              -- Finish the continuation until the next instruction;
              -- then, pause & await user.
              StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
StepNone ProgramT Action Identity a
restart

            StepMany Int
i ->
              -- Run one instruction.
              StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
StepOne ProgramT Action Identity a
restart State UiVmState (StepOutcome a)
-> (StepOutcome a -> State UiVmState (StepOutcome a))
-> State UiVmState (StepOutcome a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                \case
                  Stepped ProgramT Action Identity a
stepper ->
                    StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret (Int -> StepMode
StepMany (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ProgramT Action Identity a
stepper

                  -- This shouldn't happen, because re-stepping needs
                  -- to avoid blocking and halting.
                  StepOutcome a
r -> StepOutcome a -> State UiVmState (StepOutcome a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StepOutcome a
r

            StepUntil Pred VM
p -> do
              VM
vm <- Getting VM UiVmState VM -> StateT UiVmState Identity VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
              case Pred VM
p VM
vm of
                Bool
True ->
                  StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
StepNone ProgramT Action Identity a
restart
                Bool
False ->
                  StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
StepOne ProgramT Action Identity a
restart State UiVmState (StepOutcome a)
-> (StepOutcome a -> State UiVmState (StepOutcome a))
-> State UiVmState (StepOutcome a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    \case
                      Stepped ProgramT Action Identity a
stepper ->
                        StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret (Pred VM -> StepMode
StepUntil Pred VM
p) ProgramT Action Identity a
stepper

                      -- This means that if we hit a blocking query
                      -- or a return, we pause despite the predicate.
                      --
                      -- This could be fixed if we allowed query I/O
                      -- here, instead of only in the TTY event loop;
                      -- let's do it later.
                      StepOutcome a
r -> StepOutcome a -> State UiVmState (StepOutcome a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StepOutcome a
r

        -- Stepper wants to make a query and wait for the results?
        Stepper.Wait Query
q -> do
          Fetcher
fetcher <- Getting Fetcher UiVmState Fetcher
-> StateT UiVmState Identity Fetcher
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Fetcher UiVmState Fetcher
Lens' UiVmState Fetcher
uiVmFetcher
          -- Tell the TTY to run an I/O action to produce the next stepper.
          StepOutcome a -> State UiVmState (StepOutcome a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StepOutcome a -> State UiVmState (StepOutcome a))
-> (IO (ProgramT Action Identity a) -> StepOutcome a)
-> IO (ProgramT Action Identity a)
-> State UiVmState (StepOutcome a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (ProgramT Action Identity a) -> StepOutcome a
forall a. IO (Stepper a) -> StepOutcome a
Blocked (IO (ProgramT Action Identity a)
 -> State UiVmState (StepOutcome a))
-> IO (ProgramT Action Identity a)
-> State UiVmState (StepOutcome a)
forall a b. (a -> b) -> a -> b
$ do
            -- First run the fetcher, getting a VM state transition back.
            EVM ()
m <- Fetcher
fetcher Query
q
            -- Join that transition with the stepper script's continuation.
            ProgramT Action Identity a -> IO (ProgramT Action Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm EVM ()
m Stepper ()
-> ProgramT Action Identity a -> ProgramT Action Identity a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> ProgramT Action Identity a
k ())

        -- Stepper wants to modify the VM.
        Stepper.EVM EVM b
m -> do
          VM
vm0 <- Getting VM UiVmState VM -> StateT UiVmState Identity VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM UiVmState VM
Lens' UiVmState VM
uiVm
          let (b
r, VM
vm1) = EVM b -> VM -> (b, VM)
forall s a. State s a -> s -> (a, s)
runState EVM b
m VM
vm0
          (UiVmState -> UiVmState) -> StateT UiVmState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((UiVmState -> VM -> UiVmState) -> VM -> UiVmState -> UiVmState
forall a b c. (a -> b -> c) -> b -> a -> c
flip UiVmState -> VM -> UiVmState
updateUiVmState VM
vm1)
          (UiVmState -> UiVmState) -> StateT UiVmState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify UiVmState -> UiVmState
updateSentHashes
          StepMode
-> ProgramT Action Identity a -> State UiVmState (StepOutcome a)
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k b
r)

stepOneOpcode :: UiVmState -> UiVmState
stepOneOpcode :: UiVmState -> UiVmState
stepOneOpcode UiVmState
ui =
  let
    nextVm :: VM
nextVm = EVM () -> VM -> VM
forall s a. State s a -> s -> s
execState EVM ()
exec1 (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui)
  in
    UiVmState
ui UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState Int Int
-> (Int -> Int) -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UiVmState UiVmState Int Int
Lens' UiVmState Int
uiVmStepCount (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
       UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
nextVm

updateUiVmState :: UiVmState -> VM -> UiVmState
updateUiVmState :: UiVmState -> VM -> UiVmState
updateUiVmState UiVmState
ui VM
vm =
  UiVmState
ui UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState VM VM -> VM -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState VM VM
Lens' UiVmState VM
uiVm VM
vm

updateSentHashes :: UiVmState -> UiVmState
updateSentHashes :: UiVmState -> UiVmState
updateSentHashes UiVmState
ui =
  let sent :: Set W256
sent = VM -> Set W256
allHashes (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui) in
    UiVmState
ui UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Set W256) (Set W256)
-> Set W256 -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Set W256) (Set W256)
Lens' UiVmState (Set W256)
uiVmSentHashes Set W256
sent

type Sexp = WellFormedSExpr HaskLikeAtom

prompt :: Console (Maybe Sexp)
prompt :: Console (Maybe Sexp)
prompt = do
  String
line <- IO String -> StateT UiState IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStr String
"> " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO String
getLine)
  case SExprParser HaskLikeAtom Sexp -> Text -> Either String Sexp
forall atom carrier.
SExprParser atom carrier -> Text -> Either String carrier
decodeOne (SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
-> SExprParser HaskLikeAtom Sexp
forall a b.
SExprParser a (SExpr b) -> SExprParser a (WellFormedSExpr b)
asWellFormed SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
haskLikeParser) (String -> Text
pack String
line) of
    Left String
e -> do
      SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"error", Text -> SExpr Text
forall a. a -> SExpr a
A (String -> Text
forall a. Show a => a -> Text
txt String
e)])
      Maybe Sexp -> Console (Maybe Sexp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Sexp
forall a. Maybe a
Nothing
    Right Sexp
s ->
      Maybe Sexp -> Console (Maybe Sexp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sexp -> Maybe Sexp
forall a. a -> Maybe a
Just Sexp
s)

class SDisplay a where
  sexp :: a -> SExpr Text

display :: SDisplay a => a -> Text
display :: a -> Text
display = SExprPrinter Text (SExpr Text) -> SExpr Text -> Text
forall atom carrier. SExprPrinter atom carrier -> carrier -> Text
encodeOne ((Text -> Text) -> SExprPrinter Text (SExpr Text)
forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
basicPrint Text -> Text
forall a. a -> a
id) (SExpr Text -> Text) -> (a -> SExpr Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp

txt :: Show a => a -> Text
txt :: a -> Text
txt = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

data UiState
  = UiStarted
  | UiDappLoaded DappInfo
  | UiVm UiVmState

type Console a = StateT UiState IO a

output :: SDisplay a => a -> Console ()
output :: a -> Console ()
output = IO () -> Console ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Console ()) -> (a -> IO ()) -> a -> Console ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. SDisplay a => a -> Text
display

main :: IO ()
main :: IO ()
main = do
  String -> IO ()
putStrLn String
";; Welcome to Hevm's Emacs integration."
  UiState
_ <- Console () -> UiState -> IO UiState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Console ()
loop UiState
UiStarted
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

loop :: Console ()
loop :: Console ()
loop =
  Console (Maybe Sexp)
prompt Console (Maybe Sexp) -> (Maybe Sexp -> Console ()) -> Console ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe Sexp
Nothing -> () -> Console ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just Sexp
command -> do
        Sexp -> Console ()
handle Sexp
command
        Console ()
loop

handle :: Sexp -> Console ()
handle :: Sexp -> Console ()
handle (WFSList (WFSAtom (HSIdent Text
cmd) : [Sexp]
args)) =
  do UiState
s <- StateT UiState IO UiState
forall s (m :: * -> *). MonadState s m => m s
get
     UiState -> (Text, [Sexp]) -> Console ()
handleCmd UiState
s (Text
cmd, [Sexp]
args)
handle Sexp
_ =
  SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"unrecognized-command" :: Text)])

handleCmd :: UiState -> (Text, [Sexp]) -> Console ()
handleCmd :: UiState -> (Text, [Sexp]) -> Console ()
handleCmd UiState
UiStarted = \case
  (Text
"load-dapp",
   [WFSAtom (HSString (Text -> String
unpack -> String
root)),
    WFSAtom (HSString (Text -> String
unpack -> String
jsonPath))]) ->
    do IO () -> Console ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
setCurrentDirectory String
root)
       IO (Maybe (Map Text SolcContract, SourceCache))
-> StateT UiState IO (Maybe (Map Text SolcContract, SourceCache))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe (Map Text SolcContract, SourceCache))
readSolc String
jsonPath) StateT UiState IO (Maybe (Map Text SolcContract, SourceCache))
-> (Maybe (Map Text SolcContract, SourceCache) -> Console ())
-> Console ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         \case
           Maybe (Map Text SolcContract, SourceCache)
Nothing ->
             SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"error" :: Text)])
           Just (Map Text SolcContract
contractMap, SourceCache
sourceCache) ->
             let
               dapp :: DappInfo
dapp = String -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo String
root Map Text SolcContract
contractMap SourceCache
sourceCache
             in do
               DappInfo -> Console ()
forall a. SDisplay a => a -> Console ()
output DappInfo
dapp
               UiState -> Console ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (DappInfo -> UiState
UiDappLoaded DappInfo
dapp)

  (Text, [Sexp])
_ ->
    SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"unrecognized-command" :: Text)])

handleCmd (UiDappLoaded DappInfo
_) = \case
  (Text
"run-test", [WFSAtom (HSString Text
contractPath),
                WFSAtom (HSString Text
testName)]) -> do
    UnitTestOptions
opts <- StateT UiState IO UnitTestOptions
forall (m :: * -> *). MonadIO m => m UnitTestOptions
defaultUnitTestOptions
    UiState -> Console ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
UiVm (UnitTestOptions -> (Text, Text) -> UiVmState
initialStateForTest UnitTestOptions
opts (Text
contractPath, Text
testName)))
    Console ()
outputVm
  (Text, [Sexp])
_ ->
    SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"unrecognized-command" :: Text)])

handleCmd (UiVm UiVmState
s) = \case
  (Text
"step", [WFSAtom (HSString Text
modeName)]) ->
    case UiVmState -> Text -> Maybe StepMode
parseStepMode UiVmState
s Text
modeName of
      Just StepMode
mode -> do
        UiVmState -> StepPolicy -> StepMode -> Console ()
takeStep UiVmState
s StepPolicy
StepNormally StepMode
mode
        Console ()
outputVm
      Maybe StepMode
Nothing ->
        SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"unrecognized-command" :: Text)])
  (Text
"step", [WFSList [ WFSAtom (HSString Text
"file-line")
                    , WFSAtom (HSString Text
fileName)
                    , WFSAtom (HSInt (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
lineNumber))
                    ]]) ->
    case Getting (Maybe DappInfo) UiVmState (Maybe DappInfo)
-> UiVmState -> Maybe DappInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe DappInfo) UiVmState (Maybe DappInfo)
Lens' UiVmState (Maybe DappInfo)
uiVmDapp UiVmState
s of
      Maybe DappInfo
Nothing ->
        SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"impossible" :: Text)])
      Just DappInfo
dapp -> do
        UiVmState -> StepPolicy -> StepMode -> Console ()
takeStep UiVmState
s StepPolicy
StepNormally
          (Pred VM -> StepMode
StepUntil (DappInfo -> Text -> Int -> Pred VM
atFileLine DappInfo
dapp Text
fileName Int
lineNumber))
        Console ()
outputVm
  (Text, [Sexp])
_ ->
    SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output ([SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"unrecognized-command" :: Text)])

atFileLine :: DappInfo -> Text -> Int -> VM -> Bool
atFileLine :: DappInfo -> Text -> Int -> Pred VM
atFileLine DappInfo
dapp Text
wantedFileName Int
wantedLineNumber VM
vm =
  case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
    Maybe SrcMap
Nothing -> Bool
False
    Just SrcMap
sm ->
          let
            (Text
currentFileName, Int
currentLineNumber) =
              Maybe (Text, Int) -> (Text, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos (Getting SourceCache DappInfo SourceCache -> DappInfo -> SourceCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceCache DappInfo SourceCache
Lens' DappInfo SourceCache
dappSources DappInfo
dapp) SrcMap
sm)
          in
            Text
currentFileName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
wantedFileName Bool -> Bool -> Bool
&&
              Int
currentLineNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
wantedLineNumber

codeByHash :: W256 -> VM -> Maybe Buffer
codeByHash :: W256 -> VM -> Maybe Buffer
codeByHash W256
h VM
vm = do
  let cs :: Map Addr Contract
cs = Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
vm
  Contract
c <- (Contract -> Bool) -> [Contract] -> Maybe Contract
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Contract
c -> W256
h W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== (Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
c)) (Map Addr Contract -> [Contract]
forall k a. Map k a -> [a]
Map.elems Map Addr Contract
cs)
  Buffer -> Maybe Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (Getting Buffer Contract Buffer -> Contract -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode Contract
c)

allHashes :: VM -> Set W256
allHashes :: VM -> Set W256
allHashes VM
vm = let cs :: Map Addr Contract
cs = Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
vm
  in [W256] -> Set W256
forall a. Ord a => [a] -> Set a
Set.fromList ((Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash) (Contract -> W256) -> [Contract] -> [W256]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract -> [Contract]
forall k a. Map k a -> [a]
Map.elems Map Addr Contract
cs)

outputVm :: Console ()
outputVm :: Console ()
outputVm = do
  UiVm UiVmState
s <- StateT UiState IO UiState
forall s (m :: * -> *). MonadState s m => m s
get
  let vm :: VM
vm = Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
s
      sendHashes :: Set W256
sendHashes = Set W256 -> Set W256 -> Set W256
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (VM -> Set W256
allHashes VM
vm) (Getting (Set W256) UiVmState (Set W256) -> UiVmState -> Set W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set W256) UiVmState (Set W256)
Lens' UiVmState (Set W256)
uiVmSentHashes UiVmState
s)
      sendCodes :: Map W256 (Maybe Buffer)
sendCodes = (W256 -> Maybe Buffer) -> Set W256 -> Map W256 (Maybe Buffer)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (W256 -> VM -> Maybe Buffer
`codeByHash` VM
vm) Set W256
sendHashes
      noMap :: Console ()
noMap =
        SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output (SExpr Text -> Console ()) -> SExpr Text -> Console ()
forall a b. (a -> b) -> a -> b
$
        [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ Text -> SExpr Text
forall a. a -> SExpr a
A Text
"step"
          , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"vm" :: Text), VM -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
s)]
          ]
  Console () -> Maybe (Console ()) -> Console ()
forall a. a -> Maybe a -> a
fromMaybe Console ()
noMap (Maybe (Console ()) -> Console ())
-> Maybe (Console ()) -> Console ()
forall a b. (a -> b) -> a -> b
$ do
    DappInfo
dapp <- Getting (Maybe DappInfo) UiVmState (Maybe DappInfo)
-> UiVmState -> Maybe DappInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe DappInfo) UiVmState (Maybe DappInfo)
Lens' UiVmState (Maybe DappInfo)
uiVmDapp UiVmState
s
    SrcMap
sm <- DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
s)
    let (Text
fileName, ByteString
_) = Getting [(Text, ByteString)] DappInfo [(Text, ByteString)]
-> DappInfo -> [(Text, ByteString)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceCache -> Const [(Text, ByteString)] SourceCache)
-> DappInfo -> Const [(Text, ByteString)] DappInfo
Lens' DappInfo SourceCache
dappSources ((SourceCache -> Const [(Text, ByteString)] SourceCache)
 -> DappInfo -> Const [(Text, ByteString)] DappInfo)
-> (([(Text, ByteString)]
     -> Const [(Text, ByteString)] [(Text, ByteString)])
    -> SourceCache -> Const [(Text, ByteString)] SourceCache)
-> Getting [(Text, ByteString)] DappInfo [(Text, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, ByteString)]
 -> Const [(Text, ByteString)] [(Text, ByteString)])
-> SourceCache -> Const [(Text, ByteString)] SourceCache
Lens' SourceCache [(Text, ByteString)]
sourceFiles) DappInfo
dapp [(Text, ByteString)] -> Int -> (Text, ByteString)
forall a. [a] -> Int -> a
!! SrcMap -> Int
srcMapFile SrcMap
sm
    Console () -> Maybe (Console ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Console () -> Maybe (Console ()))
-> (SExpr Text -> Console ()) -> SExpr Text -> Maybe (Console ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SExpr Text -> Console ()
forall a. SDisplay a => a -> Console ()
output (SExpr Text -> Maybe (Console ()))
-> SExpr Text -> Maybe (Console ())
forall a b. (a -> b) -> a -> b
$
      [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ Text -> SExpr Text
forall a. a -> SExpr a
A Text
"step"
        , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"vm" :: Text), VM -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
s)]
        , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"file" :: Text), Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt Text
fileName)]
        , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ Text -> SExpr Text
forall a. a -> SExpr a
A (Text
"srcmap" :: Text)
            , Text -> SExpr Text
forall a. a -> SExpr a
A (Int -> Text
forall a. Show a => a -> Text
txt (SrcMap -> Int
srcMapOffset SrcMap
sm))
            , Text -> SExpr Text
forall a. a -> SExpr a
A (Int -> Text
forall a. Show a => a -> Text
txt (SrcMap -> Int
srcMapLength SrcMap
sm))
            , Text -> SExpr Text
forall a. a -> SExpr a
A (JumpType -> Text
forall a. Show a => a -> Text
txt (SrcMap -> JumpType
srcMapJump SrcMap
sm))
            ]
        ]


isNextSourcePosition
  :: UiVmState -> Pred VM
isNextSourcePosition :: UiVmState -> Pred VM
isNextSourcePosition UiVmState
ui VM
vm =
  let
    Just DappInfo
dapp       = Getting (Maybe DappInfo) UiVmState (Maybe DappInfo)
-> UiVmState -> Maybe DappInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe DappInfo) UiVmState (Maybe DappInfo)
Lens' UiVmState (Maybe DappInfo)
uiVmDapp UiVmState
ui
    initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp (Getting VM UiVmState VM -> UiVmState -> VM
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting VM UiVmState VM
Lens' UiVmState VM
uiVm UiVmState
ui)
  in
    DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm Maybe SrcMap -> Maybe SrcMap -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe SrcMap
initialPosition

parseStepMode :: UiVmState -> Text -> Maybe StepMode
parseStepMode :: UiVmState -> Text -> Maybe StepMode
parseStepMode UiVmState
s =
  \case
    Text
"once" -> StepMode -> Maybe StepMode
forall a. a -> Maybe a
Just StepMode
StepOne
    Text
"source-location" -> StepMode -> Maybe StepMode
forall a. a -> Maybe a
Just (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePosition UiVmState
s))
    Text
_ -> Maybe StepMode
forall a. Maybe a
Nothing

-- ^ Specifies whether to do I/O blocking or VM halting while stepping.
-- When we step backwards, we don't want to allow those things.
data StepPolicy
  = StepNormally    -- ^ Allow blocking and returning
  | StepTimidly     -- ^ Forbid blocking and returning

takeStep
  :: UiVmState
  -> StepPolicy
  -> StepMode
  -> Console ()
takeStep :: UiVmState -> StepPolicy -> StepMode -> Console ()
takeStep UiVmState
ui StepPolicy
policy StepMode
mode = do
  let m :: State UiVmState (StepOutcome ())
m = StepMode -> Stepper () -> State UiVmState (StepOutcome ())
forall a. StepMode -> Stepper a -> State UiVmState (StepOutcome a)
interpret StepMode
mode (Getting (Stepper ()) UiVmState (Stepper ())
-> UiVmState -> Stepper ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Stepper ()) UiVmState (Stepper ())
Lens' UiVmState (Stepper ())
uiVmNextStep UiVmState
ui)

  case State UiVmState (StepOutcome ())
-> UiVmState -> (StepOutcome (), UiVmState)
forall s a. State s a -> s -> (a, s)
runState State UiVmState (StepOutcome ())
m UiVmState
ui of

    (Stepped Stepper ()
stepper, UiVmState
ui') ->
      UiState -> Console ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
UiVm (UiVmState
ui' UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiVmNextStep Stepper ()
stepper))

    (Blocked IO (Stepper ())
blocker, UiVmState
ui') ->
      case StepPolicy
policy of
        StepPolicy
StepNormally -> do
          Stepper ()
stepper <- IO (Stepper ()) -> StateT UiState IO (Stepper ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Stepper ())
blocker
          UiVmState -> StepPolicy -> StepMode -> Console ()
takeStep
            (StateT UiVmState Identity () -> UiVmState -> UiVmState
forall s a. State s a -> s -> s
execState (ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
-> Stepper () -> StateT UiVmState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter UiVmState UiVmState (Stepper ()) (Stepper ())
Lens' UiVmState (Stepper ())
uiVmNextStep Stepper ()
stepper) UiVmState
ui')
            StepPolicy
StepNormally StepMode
StepNone

        StepPolicy
StepTimidly ->
          String -> Console ()
forall a. HasCallStack => String -> a
error String
"step blocked unexpectedly"

    (Returned (), UiVmState
ui') ->
      case StepPolicy
policy of
        StepPolicy
StepNormally ->
          UiState -> Console ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
UiVm UiVmState
ui')
        StepPolicy
StepTimidly ->
          String -> Console ()
forall a. HasCallStack => String -> a
error String
"step halted unexpectedly"

  -- readSolc jsonPath >>=
  --   \case
  --     Nothing -> error "Failed to read Solidity JSON"
  --     Just (contractMap, sourceCache) -> do
  --       let
  --         dapp = dappInfo root contractMap sourceCache
  --       putStrLn (unpack (display dapp))

instance SDisplay DappInfo where
  sexp :: DappInfo -> SExpr Text
sexp DappInfo
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ Text -> SExpr Text
forall a. a -> SExpr a
A Text
"dapp-info"
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"root", Text -> SExpr Text
forall a. a -> SExpr a
A (String -> Text
forall a. Show a => a -> Text
txt (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Getting String DappInfo String -> DappInfo -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String DappInfo String
Lens' DappInfo String
dappRoot DappInfo
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L (Text -> SExpr Text
forall a. a -> SExpr a
A Text
"unit-tests" SExpr Text -> [SExpr Text] -> [SExpr Text]
forall a. a -> [a] -> [a]
:
            [ [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt Text
a), [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L (((Test, [AbiType]) -> SExpr Text)
-> [(Test, [AbiType])] -> [SExpr Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> SExpr Text)
-> ((Test, [AbiType]) -> Text) -> (Test, [AbiType]) -> SExpr Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test, [AbiType]) -> Text
forall a. Show a => a -> Text
txt) [(Test, [AbiType])]
b)]
            | (Text
a, [(Test, [AbiType])]
b) <- Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
-> DappInfo -> [(Text, [(Test, [AbiType])])]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [(Text, [(Test, [AbiType])])]
  DappInfo
  [(Text, [(Test, [AbiType])])]
Lens' DappInfo [(Text, [(Test, [AbiType])])]
dappUnitTests DappInfo
x])
      ]

instance SDisplay (SExpr Text) where
  sexp :: SExpr Text -> SExpr Text
sexp = SExpr Text -> SExpr Text
forall a. a -> a
id

instance SDisplay Storage where
  sexp :: Storage -> SExpr Text
sexp (Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
_) = String -> SExpr Text
forall a. HasCallStack => String -> a
error String
"idk"
  sexp (Concrete Map Word SymWord
d) = Map Word SymWord -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp Map Word SymWord
d

instance SDisplay VM where
  sexp :: VM -> SExpr Text
sexp VM
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"result", Maybe VMResult -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"state", FrameState -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting FrameState VM FrameState -> VM -> FrameState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameState VM FrameState
Lens' VM FrameState
state VM
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"frames", [Frame] -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"contracts", Map Addr Contract -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
x)]
      ]

quoted :: Text -> Text
quoted :: Text -> Text
quoted Text
x = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

instance SDisplay Addr where
  sexp :: Addr -> SExpr Text
sexp = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> SExpr Text) -> (Addr -> Text) -> Addr -> SExpr Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
quoted (Text -> Text) -> (Addr -> Text) -> Addr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Addr -> String) -> Addr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> String
forall a. Show a => a -> String
show

instance SDisplay Contract where
  sexp :: Contract -> SExpr Text
sexp Contract
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"storage", Storage -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"balance", Word -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"nonce", Word -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"codehash", W256 -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
x)]
      ]

instance SDisplay W256 where
  sexp :: W256 -> SExpr Text
sexp W256
x = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt (W256 -> Text
forall a. Show a => a -> Text
txt W256
x))

-- no idea what's going on here
instance SDisplay (SWord 256) where
  sexp :: SWord 256 -> SExpr Text
sexp SWord 256
x = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt (SWord 256 -> Text
forall a. Show a => a -> Text
txt SWord 256
x))

-- no idea what's going on here
instance SDisplay (SymWord) where
  sexp :: SymWord -> SExpr Text
sexp SymWord
x = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt (SymWord -> Text
forall a. Show a => a -> Text
txt SymWord
x))

-- no idea what's going on here
instance SDisplay (SWord 8) where
  sexp :: SWord 8 -> SExpr Text
sexp SWord 8
x = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt (SWord 8 -> Text
forall a. Show a => a -> Text
txt SWord 8
x))

-- no idea what's going on here
instance SDisplay Buffer where
  sexp :: Buffer -> SExpr Text
sexp (SymbolicBuffer [SWord 8]
x) = [SWord 8] -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp [SWord 8]
x
  sexp (ConcreteBuffer ByteString
x) = ByteString -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp ByteString
x

instance (SDisplay k, SDisplay v) => SDisplay (Map k v) where
  sexp :: Map k v -> SExpr Text
sexp Map k v
x = [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [[SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [k -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp k
k, v -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp v
v] | (k
k, v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
x]

instance SDisplay a => SDisplay (Maybe a) where
  sexp :: Maybe a -> SExpr Text
sexp Maybe a
Nothing = Text -> SExpr Text
forall a. a -> SExpr a
A Text
"nil"
  sexp (Just a
x) = a -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp a
x

instance SDisplay VMResult where
  sexp :: VMResult -> SExpr Text
sexp = \case
    VMFailure Error
e -> [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"vm-failure", Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
forall a. Show a => a -> Text
txt (Error -> Text
forall a. Show a => a -> Text
txt Error
e))]
    VMSuccess Buffer
b -> [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"vm-success", Buffer -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp Buffer
b]

instance SDisplay Frame where
  sexp :: Frame -> SExpr Text
sexp Frame
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"frame", FrameContext -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting FrameContext Frame FrameContext -> Frame -> FrameContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameContext Frame FrameContext
Lens' Frame FrameContext
frameContext Frame
x), FrameState -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting FrameState Frame FrameState -> Frame -> FrameState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameState Frame FrameState
Lens' Frame FrameState
frameState Frame
x)]

instance SDisplay FrameContext where
  sexp :: FrameContext -> SExpr Text
sexp FrameContext
_x = Text -> SExpr Text
forall a. a -> SExpr a
A Text
"some-context"

instance SDisplay FrameState where
  sexp :: FrameState -> SExpr Text
sexp FrameState
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"contract", Addr -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting Addr FrameState Addr -> FrameState -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Addr FrameState Addr
Lens' FrameState Addr
contract FrameState
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"code-contract", Addr -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting Addr FrameState Addr -> FrameState -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Addr FrameState Addr
Lens' FrameState Addr
codeContract FrameState
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"pc", Text -> SExpr Text
forall a. a -> SExpr a
A (Int -> Text
forall a. Show a => a -> Text
txt (Getting Int FrameState Int -> FrameState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int FrameState Int
Lens' FrameState Int
pc FrameState
x))]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"stack", [SymWord] -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp (Getting [SymWord] FrameState [SymWord] -> FrameState -> [SymWord]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [SymWord] FrameState [SymWord]
Lens' FrameState [SymWord]
stack FrameState
x)]
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"memory", Buffer -> SExpr Text
sexpMemory (Getting Buffer FrameState Buffer -> FrameState -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer FrameState Buffer
Lens' FrameState Buffer
memory FrameState
x)]
      ]

instance SDisplay a => SDisplay [a] where
  sexp :: [a] -> SExpr Text
sexp = [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L ([SExpr Text] -> SExpr Text)
-> ([a] -> [SExpr Text]) -> [a] -> SExpr Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> SExpr Text) -> [a] -> [SExpr Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp

-- this overlaps the neighbouring [a] instance
instance {-# OVERLAPPING #-} SDisplay String where
  sexp :: String -> SExpr Text
sexp String
x = Text -> SExpr Text
forall a. a -> SExpr a
A (String -> Text
forall a. Show a => a -> Text
txt String
x)

instance SDisplay Word where
  sexp :: Word -> SExpr Text
sexp (C (FromKeccak Buffer
bs) W256
x) =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"hash", Text -> SExpr Text
forall a. a -> SExpr a
A (W256 -> Text
forall a. Show a => a -> Text
txt W256
x), Buffer -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp Buffer
bs]
  sexp (C Whiff
_ W256
x) = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> Text
quoted (W256 -> Text
forall a. Show a => a -> Text
txt W256
x))

instance SDisplay ByteString where
  sexp :: ByteString -> SExpr Text
sexp = Text -> SExpr Text
forall a. a -> SExpr a
A (Text -> SExpr Text)
-> (ByteString -> Text) -> ByteString -> SExpr Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. Show a => a -> Text
txt (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringS -> String
forall a. Show a => a -> String
show (ByteStringS -> String)
-> (ByteString -> ByteStringS) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringS
ByteStringS

sexpMemory :: Buffer -> SExpr Text
sexpMemory :: Buffer -> SExpr Text
sexpMemory Buffer
bs =
  if Buffer -> Int
len Buffer
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1024
  then [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A Text
"large-memory", Text -> SExpr Text
forall a. a -> SExpr a
A (Int -> Text
forall a. Show a => a -> Text
txt (Buffer -> Int
len Buffer
bs))]
  else Buffer -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp Buffer
bs

defaultUnitTestOptions :: MonadIO m => m UnitTestOptions
defaultUnitTestOptions :: m UnitTestOptions
defaultUnitTestOptions = do
  TestVMParams
params <- IO TestVMParams -> m TestVMParams
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TestVMParams -> m TestVMParams)
-> IO TestVMParams -> m TestVMParams
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO TestVMParams
getParametersFromEnvironmentVariables Maybe Text
forall a. Maybe a
Nothing
  UnitTestOptions -> m UnitTestOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitTestOptions :: Fetcher
-> Maybe Int
-> Maybe Integer
-> Maybe Int
-> Maybe Integer
-> Maybe State
-> Maybe Text
-> Text
-> Int
-> Maybe (Text, ByteString)
-> (VM -> VM)
-> DappInfo
-> TestVMParams
-> Bool
-> UnitTestOptions
UnitTestOptions
    { oracle :: Fetcher
oracle            = Fetcher
Fetch.zero
    , verbose :: Maybe Int
verbose           = Maybe Int
forall a. Maybe a
Nothing
    , maxIter :: Maybe Integer
maxIter           = Maybe Integer
forall a. Maybe a
Nothing
    , smtTimeout :: Maybe Integer
smtTimeout        = Maybe Integer
forall a. Maybe a
Nothing
    , smtState :: Maybe State
smtState          = Maybe State
forall a. Maybe a
Nothing
    , solver :: Maybe Text
solver            = Maybe Text
forall a. Maybe a
Nothing
    , match :: Text
match             = Text
""
    , fuzzRuns :: Int
fuzzRuns          = Int
100
    , replay :: Maybe (Text, ByteString)
replay            = Maybe (Text, ByteString)
forall a. Maybe a
Nothing
    , vmModifier :: VM -> VM
vmModifier        = VM -> VM
forall a. a -> a
id
    , dapp :: DappInfo
dapp              = DappInfo
emptyDapp
    , testParams :: TestVMParams
testParams        = TestVMParams
params
    , maxDepth :: Maybe Int
maxDepth          = Maybe Int
forall a. Maybe a
Nothing
    , allowFFI :: Bool
allowFFI          = Bool
False
    }

initialStateForTest
  :: UnitTestOptions
  -> (Text, Text)
  -> UiVmState
initialStateForTest :: UnitTestOptions -> (Text, Text) -> UiVmState
initialStateForTest opts :: UnitTestOptions
opts@(UnitTestOptions {Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Fetcher
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Fetcher
allowFFI :: UnitTestOptions -> Bool
maxDepth :: UnitTestOptions -> Maybe Int
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Fetcher
..}) (Text
contractPath, Text
testName) =
  UiVmState
ui1
  where
    script :: Stepper ()
script = do
      EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> (Text -> EVM ()) -> Text -> Stepper ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> (Text -> TraceData) -> Text -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TraceData
EntryTrace (Text -> Stepper ()) -> Text -> Stepper ()
forall a b. (a -> b) -> a -> b
$
        Text
"test " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contractPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
testContract
      ProgramT Action Identity Bool -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions
-> Text -> AbiValue -> ProgramT Action Identity Bool
runUnitTest UnitTestOptions
opts Text
testName (Vector AbiValue -> AbiValue
AbiTuple Vector AbiValue
forall a. Monoid a => a
mempty))
    ui0 :: UiVmState
ui0 =
      UiVmState :: VM
-> Stepper ()
-> Maybe SolcContract
-> Maybe DappInfo
-> Int
-> UiVmState
-> Fetcher
-> Maybe Text
-> Set W256
-> UiVmState
UiVmState
        { _uiVm :: VM
_uiVm             = VM
vm0
        , _uiVmNextStep :: Stepper ()
_uiVmNextStep     = Stepper ()
script
        , _uiVmSolc :: Maybe SolcContract
_uiVmSolc         = SolcContract -> Maybe SolcContract
forall a. a -> Maybe a
Just SolcContract
testContract
        , _uiVmDapp :: Maybe DappInfo
_uiVmDapp         = Maybe DappInfo
forall a. Maybe a
Nothing
        , _uiVmStepCount :: Int
_uiVmStepCount    = Int
0
        , _uiVmFirstState :: UiVmState
_uiVmFirstState   = UiVmState
forall a. HasCallStack => a
undefined
        , _uiVmFetcher :: Fetcher
_uiVmFetcher      = Fetcher
oracle
        , _uiVmMessage :: Maybe Text
_uiVmMessage      = Maybe Text
forall a. Maybe a
Nothing
        , _uiVmSentHashes :: Set W256
_uiVmSentHashes   = Set W256
forall a. Set a
Set.empty
        }
    Just SolcContract
testContract =
      Getting (Maybe SolcContract) DappInfo (Maybe SolcContract)
-> DappInfo -> Maybe SolcContract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map Text SolcContract
 -> Const (Maybe SolcContract) (Map Text SolcContract))
-> DappInfo -> Const (Maybe SolcContract) DappInfo
Lens' DappInfo (Map Text SolcContract)
dappSolcByName ((Map Text SolcContract
  -> Const (Maybe SolcContract) (Map Text SolcContract))
 -> DappInfo -> Const (Maybe SolcContract) DappInfo)
-> ((Maybe SolcContract
     -> Const (Maybe SolcContract) (Maybe SolcContract))
    -> Map Text SolcContract
    -> Const (Maybe SolcContract) (Map Text SolcContract))
-> Getting (Maybe SolcContract) DappInfo (Maybe SolcContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text SolcContract)
-> Lens'
     (Map Text SolcContract) (Maybe (IxValue (Map Text SolcContract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text SolcContract)
contractPath) DappInfo
dapp
    vm0 :: VM
vm0 =
      UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
testContract
    ui1 :: UiVmState
ui1 =
      UiVmState -> VM -> UiVmState
updateUiVmState UiVmState
ui0 VM
vm0 UiVmState -> (UiVmState -> UiVmState) -> UiVmState
forall a b. a -> (a -> b) -> b
& ASetter UiVmState UiVmState UiVmState UiVmState
-> UiVmState -> UiVmState -> UiVmState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UiVmState UiVmState UiVmState UiVmState
Lens' UiVmState UiVmState
uiVmFirstState UiVmState
ui1