{-# 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 mode :: 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 x :: 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 :: Action b
action Operational.:>>= k :: b -> ProgramT Action Identity a
k) =
      case Action b
action of
        -- Stepper wants to keep executing?
        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
            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))

            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
                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 r :: 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 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 i :: 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 stepper :: 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
- 1)) ProgramT Action Identity a
stepper

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

            StepUntil p :: 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
                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
                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 stepper :: 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.
                      r :: 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 q :: 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 m :: 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 (r :: b
r, vm1 :: 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 ui :: 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
+ 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 ui :: UiVmState
ui vm :: 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 ui :: 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 "> " 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 e :: 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 "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 s :: 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 ";; 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
      Nothing -> () -> Console ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just command :: Sexp
command -> do
        Sexp -> Console ()
handle Sexp
command
        Console ()
loop

handle :: Sexp -> Console ()
handle :: Sexp -> Console ()
handle (WFSList (WFSAtom (HSIdent cmd :: Text
cmd) : args :: [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 _ =
  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 ("unrecognized-command" :: Text)])

handleCmd :: UiState -> (Text, [Sexp]) -> Console ()
handleCmd :: UiState -> (Text, [Sexp]) -> Console ()
handleCmd UiStarted = \case
  ("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
           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 ("error" :: Text)])
           Just (contractMap :: Map Text SolcContract
contractMap, sourceCache :: 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)

  _ ->
    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 ("unrecognized-command" :: Text)])

handleCmd (UiDappLoaded _) = \case
  ("run-test", [WFSAtom (HSString contractPath :: Text
contractPath),
                WFSAtom (HSString testName :: 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
  _ ->
    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 ("unrecognized-command" :: Text)])

handleCmd (UiVm s :: UiVmState
s) = \case
  ("step", [WFSAtom (HSString modeName :: Text
modeName)]) ->
    case UiVmState -> Text -> Maybe StepMode
parseStepMode UiVmState
s Text
modeName of
      Just mode :: StepMode
mode -> do
        UiVmState -> StepPolicy -> StepMode -> Console ()
takeStep UiVmState
s StepPolicy
StepNormally StepMode
mode
        Console ()
outputVm
      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 ("unrecognized-command" :: Text)])
  ("step", [WFSList [ WFSAtom (HSString "file-line")
                    , WFSAtom (HSString fileName :: 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
      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 ("impossible" :: Text)])
      Just dapp :: 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
  _ ->
    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 ("unrecognized-command" :: Text)])

atFileLine :: DappInfo -> Text -> Int -> VM -> Bool
atFileLine :: DappInfo -> Text -> Int -> Pred VM
atFileLine dapp :: DappInfo
dapp wantedFileName :: Text
wantedFileName wantedLineNumber :: Int
wantedLineNumber vm :: VM
vm =
  case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
    Nothing -> Bool
False
    Just sm :: SrcMap
sm ->
      case Getting
  (Maybe (Text, ByteString)) DappInfo (Maybe (Text, ByteString))
-> DappInfo -> Maybe (Text, ByteString)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
-> DappInfo -> Const (Maybe (Text, ByteString)) DappInfo
Lens' DappInfo SourceCache
dappSources ((SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
 -> DappInfo -> Const (Maybe (Text, ByteString)) DappInfo)
-> ((Maybe (Text, ByteString)
     -> Const (Maybe (Text, ByteString)) (Maybe (Text, ByteString)))
    -> SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
-> Getting
     (Maybe (Text, ByteString)) DappInfo (Maybe (Text, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Int (Text, ByteString)
 -> Const (Maybe (Text, ByteString)) (Map Int (Text, ByteString)))
-> SourceCache -> Const (Maybe (Text, ByteString)) SourceCache
Lens' SourceCache (Map Int (Text, ByteString))
sourceFiles ((Map Int (Text, ByteString)
  -> Const (Maybe (Text, ByteString)) (Map Int (Text, ByteString)))
 -> SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
-> ((Maybe (Text, ByteString)
     -> Const (Maybe (Text, ByteString)) (Maybe (Text, ByteString)))
    -> Map Int (Text, ByteString)
    -> Const (Maybe (Text, ByteString)) (Map Int (Text, ByteString)))
-> (Maybe (Text, ByteString)
    -> Const (Maybe (Text, ByteString)) (Maybe (Text, ByteString)))
-> SourceCache
-> Const (Maybe (Text, ByteString)) SourceCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Int (Text, ByteString))
-> Lens'
     (Map Int (Text, ByteString))
     (Maybe (IxValue (Map Int (Text, ByteString))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (SrcMap -> Int
srcMapFile SrcMap
sm)) DappInfo
dapp of
        Nothing -> Bool
False
        Just _ ->
          let
            (currentFileName :: Text
currentFileName, currentLineNumber :: 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 h :: W256
h vm :: 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 (\c :: 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
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 s :: 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 "step"
          , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A ("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)
    (fileName :: Text
fileName, _) <- Getting
  (Maybe (Text, ByteString)) DappInfo (Maybe (Text, ByteString))
-> DappInfo -> Maybe (Text, ByteString)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
-> DappInfo -> Const (Maybe (Text, ByteString)) DappInfo
Lens' DappInfo SourceCache
dappSources ((SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
 -> DappInfo -> Const (Maybe (Text, ByteString)) DappInfo)
-> ((Maybe (Text, ByteString)
     -> Const (Maybe (Text, ByteString)) (Maybe (Text, ByteString)))
    -> SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
-> Getting
     (Maybe (Text, ByteString)) DappInfo (Maybe (Text, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Int (Text, ByteString)
 -> Const (Maybe (Text, ByteString)) (Map Int (Text, ByteString)))
-> SourceCache -> Const (Maybe (Text, ByteString)) SourceCache
Lens' SourceCache (Map Int (Text, ByteString))
sourceFiles ((Map Int (Text, ByteString)
  -> Const (Maybe (Text, ByteString)) (Map Int (Text, ByteString)))
 -> SourceCache -> Const (Maybe (Text, ByteString)) SourceCache)
-> ((Maybe (Text, ByteString)
     -> Const (Maybe (Text, ByteString)) (Maybe (Text, ByteString)))
    -> Map Int (Text, ByteString)
    -> Const (Maybe (Text, ByteString)) (Map Int (Text, ByteString)))
-> (Maybe (Text, ByteString)
    -> Const (Maybe (Text, ByteString)) (Maybe (Text, ByteString)))
-> SourceCache
-> Const (Maybe (Text, ByteString)) SourceCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Int (Text, ByteString))
-> Lens'
     (Map Int (Text, ByteString))
     (Maybe (IxValue (Map Int (Text, ByteString))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (SrcMap -> Int
srcMapFile SrcMap
sm)) DappInfo
dapp
    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 "step"
        , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A ("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 ("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 ("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 ui :: UiVmState
ui vm :: VM
vm =
  let
    Just dapp :: 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 s :: UiVmState
s =
  \case
    "once" -> StepMode -> Maybe StepMode
forall a. a -> Maybe a
Just StepMode
StepOne
    "source-location" -> StepMode -> Maybe StepMode
forall a. a -> Maybe a
Just (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePosition UiVmState
s))
    _ -> 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 ui :: UiVmState
ui policy :: StepPolicy
policy mode :: 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 ()
stepper, ui' :: 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 blocker :: IO (Stepper ())
blocker, ui' :: UiVmState
ui') ->
      case StepPolicy
policy of
        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

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

    (Returned (), ui' :: UiVmState
ui') ->
      case StepPolicy
policy of
        StepNormally ->
          UiState -> Console ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
UiVm UiVmState
ui')
        StepTimidly ->
          String -> Console ()
forall a. HasCallStack => String -> a
error "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 x :: DappInfo
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [ Text -> SExpr Text
forall a. a -> SExpr a
A "dapp-info"
      , [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A "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 "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)]
            | (a :: Text
a, b :: [(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 _ _) = String -> SExpr Text
forall a. HasCallStack => String -> a
error "idk"
  sexp (Concrete d :: 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 x :: 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 "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 "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 "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 "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 x :: Text
x = "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""

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 x :: 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 "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 "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 "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 "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 x :: 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 x :: 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 x :: 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 x :: 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 x :: [SWord 8]
x) = [SWord 8] -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp [SWord 8]
x
  sexp (ConcreteBuffer x :: 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 x :: 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
k, v :: 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 Nothing = Text -> SExpr Text
forall a. a -> SExpr a
A "nil"
  sexp (Just x :: 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 e :: Error
e -> [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A "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 b :: Buffer
b -> [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A "vm-success", Buffer -> SExpr Text
forall a. SDisplay a => a -> SExpr Text
sexp Buffer
b]

instance SDisplay Frame where
  sexp :: Frame -> SExpr Text
sexp x :: Frame
x =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A "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 _x :: FrameContext
_x = Text -> SExpr Text
forall a. a -> SExpr a
A "some-context"

instance SDisplay FrameState where
  sexp :: FrameState -> SExpr Text
sexp x :: 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 "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 "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 "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 "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 "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 x :: 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 bs :: Buffer
bs) x :: W256
x) =
    [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A "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 _ x :: 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 bs :: Buffer
bs =
  if Buffer -> Int
len Buffer
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1024
  then [SExpr Text] -> SExpr Text
forall a. [SExpr a] -> SExpr a
L [Text -> SExpr Text
forall a. a -> SExpr a
A "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 Integer
-> Maybe State
-> Maybe Text
-> Text
-> Int
-> Maybe (Text, ByteString)
-> (VM -> VM)
-> DappInfo
-> TestVMParams
-> 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             = ""
    , fuzzRuns :: Int
fuzzRuns          = 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
    }

initialStateForTest
  :: UnitTestOptions
  -> (Text, Text)
  -> UiVmState
initialStateForTest :: UnitTestOptions -> (Text, Text) -> UiVmState
initialStateForTest opts :: UnitTestOptions
opts@(UnitTestOptions {..}) (contractPath :: Text
contractPath, testName :: 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
$
        "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
forall a. Semigroup a => a -> a -> a
<> Text
contractPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
      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    = 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 testContract :: 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