{-# Language TemplateHaskell #-}
{-# Language UndecidableInstances #-}
{-# Language ImplicitParams #-}
{-# Language DataKinds #-}
module EVM.TTY where
import Prelude hiding (lookup, Word)
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.List
import EVM
import EVM.ABI (decodeAbiValue, emptyAbi, abiTypeSolidity, AbiType(..))
import EVM.SymExec (maxIterationsReached, symCalldata)
import EVM.Expr (simplify)
import EVM.Dapp (DappInfo(..), emptyDapp, dappInfo, Test, extractSig, Test(..), srcMap, unitTestMethods)
import EVM.Debug
import EVM.Fetch (Fetcher)
import EVM.Fetch qualified as Fetch
import EVM.Format (showWordExact, showWordExplanation, contractNamePart,
contractPathPart, showTraceTree, prettyIfConcreteWord, formatExpr)
import EVM.Hexdump (prettyHex)
import EVM.Solvers (SolverGroup)
import EVM.Op
import EVM.Solidity hiding (storageLayout)
import EVM.Types hiding (padRight, Max)
import EVM.UnitTest
import EVM.Stepper (Stepper)
import EVM.Stepper qualified as Stepper
import EVM.StorageLayout
import EVM.TTYCenteredList qualified as Centered
import Optics.Core
import Optics.State
import Optics.TH
import Control.Monad.Operational qualified as Operational
import Control.Monad.State.Strict hiding (state)
import Data.Aeson.Optics
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.List (sort, find)
import Data.Maybe (isJust, fromJust, fromMaybe, isNothing)
import Data.Map (Map, insert, lookupLT, singleton, filter, (!?))
import Data.Map qualified as Map
import Data.Text (Text, pack)
import Data.Text qualified as T
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8)
import Data.Vector qualified as Vec
import Data.Vector.Storable qualified as SVec
import Data.Version (showVersion)
import Graphics.Vty qualified as V
import System.Console.Haskeline qualified as Readline
import Paths_hevm qualified as Paths
import Text.Wrap
data Name
= AbiPane
| StackPane
| BytecodePane
| TracePane
| SolidityPane
| TestPickerPane
| BrowserPane
|
deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord)
type UiWidget = Widget Name
data UiVmState = UiVmState
{ UiVmState -> VM
vm :: VM
, UiVmState -> Int
step :: Int
, UiVmState -> Map Int (VM, Stepper ())
snapshots :: Map Int (VM, Stepper ())
, UiVmState -> Stepper ()
stepper :: Stepper ()
, UiVmState -> Bool
showMemory :: Bool
, UiVmState -> UnitTestOptions
testOpts :: UnitTestOptions
}
data UiTestPickerState = UiTestPickerState
{ UiTestPickerState -> GenericList Name Vector (Text, Text)
tests :: List Name (Text, Text)
, UiTestPickerState -> DappInfo
dapp :: DappInfo
, UiTestPickerState -> UnitTestOptions
opts :: UnitTestOptions
}
data UiBrowserState = UiBrowserState
{ UiBrowserState -> GenericList Name Vector (Addr, Contract)
contracts :: List Name (Addr, Contract)
, UiBrowserState -> UiVmState
vm :: UiVmState
}
data UiState
= ViewVm UiVmState
| ViewContracts UiBrowserState
| ViewPicker UiTestPickerState
| ViewHelp UiVmState
makeFieldLabelsNoPrefix ''UiVmState
makeFieldLabelsNoPrefix ''UiTestPickerState
makeFieldLabelsNoPrefix ''UiBrowserState
makePrisms ''UiState
snapshotInterval :: Int
snapshotInterval :: Int
snapshotInterval = Int
50
type Pred a = a -> Bool
data StepMode
= Step !Int
| StepUntil (Pred VM)
data Continuation a
= Stopped a
| Continue (Stepper a)
interpret
:: (?fetcher :: Fetcher
, ?maxIter :: Maybe Integer)
=> StepMode
-> Stepper a
-> StateT UiVmState IO (Continuation a)
interpret :: forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode =
forall a.
ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
Operational.view
where
eval
:: Operational.ProgramView Stepper.Action a
-> StateT UiVmState IO (Continuation a)
eval :: forall a.
ProgramView Action a -> StateT UiVmState IO (Continuation a)
eval (Operational.Return a
x) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Continuation a
Stopped a
x)
eval (Action b
action Operational.:>>= b -> ProgramT Action Identity a
k) =
case Action b
action of
Action b
Stepper.Run -> do
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just VMResult
_ -> do
b
vm <- forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall a. IsLabel "vm" a => a
#vm
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k b
vm)
Maybe VMResult
Nothing -> do
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode (Stepper VM
Stepper.run forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Action b
Stepper.Exec -> do
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just b
r ->
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (b -> ProgramT Action Identity a
k b
r)
Maybe b
Nothing -> do
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode (Stepper VMResult
Stepper.exec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Stepper.Ask (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
cont) -> do
VM
vm <- forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall a. IsLabel "vm" a => a
#vm
case VM -> Maybe Integer -> Maybe Bool
maxIterationsReached VM
vm ?maxIter::Maybe Integer
?maxIter of
Maybe Bool
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Stepper a -> Continuation a
Continue (b -> ProgramT Action Identity a
k ())
Just Bool
n -> forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
cont (Bool -> Bool
not Bool
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Stepper.Wait (PleaseAskSMT (Lit W256
c) [Prop]
_ BranchCondition -> EVM ()
continue) ->
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (forall a. EVM a -> Stepper a
Stepper.evm (BranchCondition -> EVM ()
continue (Bool -> BranchCondition
Case (W256
c forall a. Ord a => a -> a -> Bool
> W256
0))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Stepper.Wait Query
q -> do
do EVM b
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (?fetcher::Query -> IO (EVM b)
?fetcher Query
q)
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (forall a. EVM a -> Stepper a
Stepper.evm EVM b
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Stepper.IOAct StateT VM IO b
q -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (forall k (is :: IxList) s t a b.
Is k A_Lens =>
Optic k is s t a b -> LensVL s t a b
toLensVL forall a. IsLabel "vm" a => a
#vm) (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT VM IO b
q)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
Stepper.EVM EVM b
m -> do
VM
vm <- forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall a. IsLabel "vm" a => a
#vm
let (b
r, VM
vm1) = forall s a. State s a -> s -> (a, s)
runState EVM b
m VM
vm
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall a. IsLabel "vm" a => a
#vm VM
vm1
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode (Stepper VMResult
Stepper.exec forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (b -> ProgramT Action Identity a
k b
r))
keepExecuting :: (?fetcher :: Fetcher
, ?maxIter :: Maybe Integer)
=> StepMode
-> Stepper a
-> StateT UiVmState IO (Continuation a)
keepExecuting :: forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
keepExecuting StepMode
mode Stepper a
restart = case StepMode
mode of
Step Int
0 -> do
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Stepper a -> Continuation a
Continue Stepper a
restart)
Step Int
i -> do
forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step (Int
i forall a. Num a => a -> a -> a
- Int
1)) Stepper a
restart
StepUntil Pred VM
p -> do
VM
vm <- forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall a. IsLabel "vm" a => a
#vm
if Pred VM
p VM
vm
then
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step Int
0) Stepper a
restart
else do
forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart
forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Pred VM -> StepMode
StepUntil Pred VM
p) Stepper a
restart
isUnitTestContract :: Text -> DappInfo -> Bool
isUnitTestContract :: Text -> DappInfo -> Bool
isUnitTestContract Text
name DappInfo
dapp =
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
name (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst DappInfo
dapp.unitTests)
mkVty :: IO V.Vty
mkVty :: IO Vty
mkVty = do
Vty
vty <- Config -> IO Vty
V.mkVty Config
V.defaultConfig
Output -> Mode -> Bool -> IO ()
V.setMode (Vty -> Output
V.outputIface Vty
vty) Mode
V.BracketedPaste Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty
runFromVM :: SolverGroup -> Fetch.RpcInfo -> Maybe Integer -> DappInfo -> VM -> IO VM
runFromVM :: SolverGroup -> RpcInfo -> Maybe Integer -> DappInfo -> VM -> IO VM
runFromVM SolverGroup
solvers RpcInfo
rpcInfo Maybe Integer
maxIter' DappInfo
dappinfo VM
vm = do
let
opts :: UnitTestOptions
opts = UnitTestOptions
{ $sel:solvers:UnitTestOptions :: SolverGroup
solvers = SolverGroup
solvers
, $sel:rpcInfo:UnitTestOptions :: RpcInfo
rpcInfo = RpcInfo
rpcInfo
, $sel:verbose:UnitTestOptions :: Maybe Int
verbose = forall a. Maybe a
Nothing
, $sel:maxIter:UnitTestOptions :: Maybe Integer
maxIter = Maybe Integer
maxIter'
, $sel:askSmtIters:UnitTestOptions :: Integer
askSmtIters = Integer
1
, $sel:smtTimeout:UnitTestOptions :: Maybe Natural
smtTimeout = forall a. Maybe a
Nothing
, $sel:smtDebug:UnitTestOptions :: Bool
smtDebug = Bool
False
, $sel:solver:UnitTestOptions :: Maybe Text
solver = forall a. Maybe a
Nothing
, $sel:maxDepth:UnitTestOptions :: Maybe Int
maxDepth = forall a. Maybe a
Nothing
, $sel:match:UnitTestOptions :: Text
match = Text
""
, $sel:fuzzRuns:UnitTestOptions :: Int
fuzzRuns = Int
1
, $sel:replay:UnitTestOptions :: Maybe (Text, ByteString)
replay = forall a. HasCallStack => String -> a
error String
"irrelevant"
, $sel:vmModifier:UnitTestOptions :: VM -> VM
vmModifier = forall a. a -> a
id
, $sel:testParams:UnitTestOptions :: TestVMParams
testParams = forall a. HasCallStack => String -> a
error String
"irrelevant"
, $sel:dapp:UnitTestOptions :: DappInfo
dapp = DappInfo
dappinfo
, $sel:ffiAllowed:UnitTestOptions :: Bool
ffiAllowed = Bool
False
, $sel:covMatch:UnitTestOptions :: Maybe Text
covMatch = forall a. Maybe a
Nothing
}
ui0 :: UiVmState
ui0 = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm UnitTestOptions
opts (forall (f :: * -> *) a. Functor f => f a -> f ()
void Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully)
Vty
v <- IO Vty
mkVty
UiState
ui2 <- forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
v IO Vty
mkVty forall a. Maybe a
Nothing (UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts) (UiVmState -> UiState
ViewVm UiVmState
ui0)
case UiState
ui2 of
ViewVm UiVmState
ui -> forall (m :: * -> *) a. Monad m => a -> m a
return UiVmState
ui.vm
UiState
_ -> forall a. HasCallStack => String -> a
error String
"internal error: customMain returned prematurely"
initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script =
UiVmState
{ $sel:vm:UiVmState :: VM
vm = VM
vm0
, $sel:stepper:UiVmState :: Stepper ()
stepper = Stepper ()
script
, $sel:step:UiVmState :: Int
step = Int
0
, $sel:snapshots:UiVmState :: Map Int (VM, Stepper ())
snapshots = forall k a. k -> a -> Map k a
singleton Int
0 (VM
vm0, Stepper ()
script)
, $sel:showMemory:UiVmState :: Bool
showMemory = Bool
False
, $sel:testOpts:UiVmState :: UnitTestOptions
testOpts = UnitTestOptions
opts
}
debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions{Bool
Int
Integer
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
ffiAllowed :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
covMatch :: Maybe Text
solver :: Maybe Text
smtTimeout :: Maybe Natural
maxDepth :: Maybe Int
smtDebug :: Bool
askSmtIters :: Integer
maxIter :: Maybe Integer
verbose :: Maybe Int
solvers :: SolverGroup
rpcInfo :: RpcInfo
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
..} (Text
contractname, [(Test, [AbiType])]
tests) = case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> [(Text
contractname, Test -> Text
extractSig forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Test, [AbiType])
x) | (Test, [AbiType])
x <- [(Test, [AbiType])]
tests, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Test, [AbiType]) -> Bool
isFuzzTest (Test, [AbiType])
x]
Just (Text
sig, ByteString
_) -> [(Text
contractname, Test -> Text
extractSig forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Test, [AbiType])
x) | (Test, [AbiType])
x <- [(Test, [AbiType])]
tests, Bool -> Bool
not ((Test, [AbiType]) -> Bool
isFuzzTest (Test, [AbiType])
x) Bool -> Bool -> Bool
|| Test -> Text
extractSig (forall a b. (a, b) -> a
fst (Test, [AbiType])
x) forall a. Eq a => a -> a -> Bool
== Text
sig]
isFuzzTest :: (Test, [AbiType]) -> Bool
isFuzzTest :: (Test, [AbiType]) -> Bool
isFuzzTest (SymbolicTest Text
_, [AbiType]
_) = Bool
False
isFuzzTest (ConcreteTest Text
_, []) = Bool
False
isFuzzTest (ConcreteTest Text
_, [AbiType]
_) = Bool
True
isFuzzTest (InvariantTest Text
_, [AbiType]
_) = Bool
True
main :: UnitTestOptions -> FilePath -> Maybe BuildOutput -> IO ()
main :: UnitTestOptions -> String -> Maybe BuildOutput -> IO ()
main UnitTestOptions
opts String
root Maybe BuildOutput
buildOutput = do
let
dapp :: DappInfo
dapp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe DappInfo
emptyDapp (String -> BuildOutput -> DappInfo
dappInfo String
root) Maybe BuildOutput
buildOutput
ui :: UiState
ui = UiTestPickerState -> UiState
ViewPicker forall a b. (a -> b) -> a -> b
$ UiTestPickerState
{ $sel:tests:UiTestPickerState :: GenericList Name Vector (Text, Text)
tests =
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
Name
TestPickerPane
(forall a. [a] -> Vector a
Vec.fromList
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions
opts)
DappInfo
dapp.unitTests))
Int
1
, $sel:dapp:UiTestPickerState :: DappInfo
dapp = DappInfo
dapp
, $sel:opts:UiTestPickerState :: UnitTestOptions
opts = UnitTestOptions
opts
}
Vty
v <- IO Vty
mkVty
UiState
_ <- forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
v IO Vty
mkVty forall a. Maybe a
Nothing (UnitTestOptions -> App UiState () Name
app UnitTestOptions
opts) (UiState
ui :: UiState)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
takeStep
:: (?fetcher :: Fetcher
,?maxIter :: Maybe Integer)
=> UiVmState
-> StepMode
-> EventM n UiState ()
takeStep :: forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
ui StepMode
mode =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Continuation (), UiVmState)
nxt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Stopped (), UiVmState
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Continue Stepper ()
steps, UiVmState
ui') ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm (UiVmState
ui' forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
steps))
where
m :: StateT UiVmState IO (Continuation ())
m = forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret StepMode
mode UiVmState
ui.stepper
nxt :: IO (Continuation (), UiVmState)
nxt = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT UiVmState IO (Continuation ())
m UiVmState
ui
backstepUntil
:: (?fetcher :: Fetcher
,?maxIter :: Maybe Integer)
=> (UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil :: forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
p = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case UiVmState
s.step of
Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
n -> do
UiVmState
s1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> IO UiVmState
backstep UiVmState
s
let
snapshots' :: Map Int (VM, Stepper ())
snapshots' = forall a k. (a -> Bool) -> Map k a -> Map k a
Data.Map.filter (UiVmState -> Pred VM
p UiVmState
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) UiVmState
s1.snapshots
case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n Map Int (VM, Stepper ())
snapshots' of
Maybe (Int, (VM, Stepper ()))
Nothing ->
let
(Int
step', (VM
vm', Stepper ()
stepper')) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT (Int
n forall a. Num a => a -> a -> a
- Int
1) UiVmState
s.snapshots
s2 :: UiVmState
s2 = UiVmState
s1
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "vm" a => a
#vm VM
vm'
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cache" a => a
#cache) UiVmState
s1.vm.cache
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "step" a => a
#step Int
step'
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
stepper'
in forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s2 (Int -> StepMode
Step Int
0)
Just (Int
step', (VM
vm', Stepper ()
stepper')) ->
let
s2 :: UiVmState
s2 = UiVmState
s1
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "vm" a => a
#vm VM
vm'
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cache" a => a
#cache) UiVmState
s1.vm.cache
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "step" a => a
#step Int
step'
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
stepper'
in forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s2 (Pred VM -> StepMode
StepUntil (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiVmState -> Pred VM
p UiVmState
s1))
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
backstep
:: (?fetcher :: Fetcher
,?maxIter :: Maybe Integer)
=> UiVmState -> IO UiVmState
backstep :: (?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> IO UiVmState
backstep UiVmState
s =
case UiVmState
s.step of
Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure UiVmState
s
Int
n ->
let
(Int
step, (VM
vm, Stepper ()
stepper)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n UiVmState
s.snapshots
s1 :: UiVmState
s1 = UiVmState
s
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "vm" a => a
#vm VM
vm
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cache" a => a
#cache) UiVmState
s.vm.cache
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "step" a => a
#step Int
step
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
stepper
stepsToTake :: Int
stepsToTake = Int
n forall a. Num a => a -> a -> a
- Int
step forall a. Num a => a -> a -> a
- Int
1
in
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall a.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
StepMode -> Stepper a -> StateT UiVmState IO (Continuation a)
interpret (Int -> StepMode
Step Int
stepsToTake) Stepper ()
stepper) UiVmState
s1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Continue Stepper ()
steps, UiVmState
ui') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UiVmState
ui' forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
steps
(Continuation (), UiVmState)
_ -> forall a. HasCallStack => String -> a
error String
"unexpected end"
appEvent
:: (?fetcher::Fetcher, ?maxIter :: Maybe Integer) =>
BrickEvent Name e ->
EventM Name UiState ()
appEvent :: forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
BrickEvent Name e -> EventM Name UiState ()
appEvent (VtyEvent e :: Event
e@(V.EvKey Key
V.KDown [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewContracts UiBrowserState
_s -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf forall a b. (a -> b) -> a -> b
$ Prism' UiState UiBrowserState
_ViewContracts forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "contracts" a => a
#contracts)
(forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ViewPicker UiTestPickerState
_s -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf forall a b. (a -> b) -> a -> b
$ Prism' UiState UiTestPickerState
_ViewPicker forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "tests" a => a
#tests)
(forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure()
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent e :: Event
e@(V.EvKey Key
V.KUp [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewContracts UiBrowserState
_s -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf forall a b. (a -> b) -> a -> b
$ Prism' UiState UiBrowserState
_ViewContracts forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "contracts" a => a
#contracts)
(forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
ViewPicker UiTestPickerState
_s -> do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom
(forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf forall a b. (a -> b) -> a -> b
$ Prism' UiState UiTestPickerState
_ViewPicker forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "tests" a => a
#tests)
(forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure()
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey Key
V.KEsc [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s -> do
let opts :: UnitTestOptions
opts = UiVmState
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "testOpts" a => a
#testOpts
dapp :: DappInfo
dapp = UnitTestOptions
opts.dapp
tests :: [(Text, Text)]
tests = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)]
debuggableTests UnitTestOptions
opts) DappInfo
dapp.unitTests
case [(Text, Text)]
tests of
[] -> forall n s. EventM n s ()
halt
[(Text, Text)]
ts ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ UiTestPickerState -> UiState
ViewPicker forall a b. (a -> b) -> a -> b
$ UiTestPickerState
{ $sel:tests:UiTestPickerState :: GenericList Name Vector (Text, Text)
tests = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
TestPickerPane (forall a. [a] -> Vector a
Vec.fromList [(Text, Text)]
ts) Int
1
, $sel:dapp:UiTestPickerState :: DappInfo
dapp = DappInfo
dapp
, $sel:opts:UiTestPickerState :: UnitTestOptions
opts = UnitTestOptions
opts
}
ViewHelp UiVmState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm UiVmState
s)
ViewContracts UiBrowserState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm forall a b. (a -> b) -> a -> b
$ UiBrowserState
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vm" a => a
#vm)
UiState
_ -> forall n s. EventM n s ()
halt
appEvent (VtyEvent (V.EvKey Key
V.KEnter [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. UiBrowserState -> UiState
ViewContracts forall a b. (a -> b) -> a -> b
$ UiBrowserState
{ $sel:contracts:UiBrowserState :: GenericList Name Vector (Addr, Contract)
contracts =
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
Name
BrowserPane
(forall a. [a] -> Vector a
Vec.fromList (forall k a. Map k a -> [(k, a)]
Map.toList UiVmState
s.vm.env.contracts))
Int
2
, $sel:vm:UiBrowserState :: UiVmState
vm = UiVmState
s
}
ViewPicker UiTestPickerState
s ->
case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement UiTestPickerState
s.tests of
Maybe (Int, (Text, Text))
Nothing -> forall a. HasCallStack => String -> a
error String
"nothing selected"
Just (Int
_, (Text, Text)
x) -> do
let initVm :: UiVmState
initVm = UnitTestOptions -> (Text, Text) -> UiVmState
initialUiVmStateForTest UiTestPickerState
s.opts (Text, Text)
x
forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm UiVmState
initVm)
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'm') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewVm forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "showMemory" a => a
#showMemory Bool -> Bool
not UiVmState
s)
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'h') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (UiVmState -> UiState
ViewHelp UiVmState
s)
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
' ') [])) =
let
loop :: InputT IO ()
loop = do
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Readline.getInputLine String
"% " forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just String
hey -> forall (m :: * -> *). MonadIO m => String -> InputT m ()
Readline.outputStrLn String
hey
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Readline.getInputLine String
"% " forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just String
hey' -> forall (m :: * -> *). MonadIO m => String -> InputT m ()
Readline.outputStrLn String
hey'
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
in do
UiState
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
Readline.runInputT forall (m :: * -> *). MonadIO m => Settings m
Readline.defaultSettings InputT IO ()
loop
forall (f :: * -> *) a. Applicative f => a -> f a
pure UiState
s
appEvent (VtyEvent (V.EvKey (V.KChar Char
'n') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result)) forall a b. (a -> b) -> a -> b
$
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Int -> StepMode
Step Int
1)
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'N') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result)) forall a b. (a -> b) -> a -> b
$
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePosition UiVmState
s))
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result)) forall a b. (a -> b) -> a -> b
$
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
s))
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'e') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (UiVmState
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result)) forall a b. (a -> b) -> a -> b
$
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s (Pred VM -> StepMode
StepUntil (UiVmState -> Pred VM
isExecutionHalted UiVmState
s))
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'a') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
let
(VM
vm, Stepper ()
stepper) = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
0 UiVmState
s.snapshots)
s' :: UiVmState
s' = UiVmState
s
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "vm" a => a
#vm VM
vm
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cache" a => a
#cache) UiVmState
s.vm.cache
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "step" a => a
#step Int
0
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
stepper
in forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s' (Int -> StepMode
Step Int
0)
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'p') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case UiVmState
s.step of
Int
0 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int
n -> do
let
(Int
step, (VM
vm, Stepper ()
stepper)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
lookupLT Int
n UiVmState
s.snapshots
s1 :: UiVmState
s1 = UiVmState
s
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "vm" a => a
#vm VM
vm
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cache" a => a
#cache) UiVmState
s.vm.cache
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "step" a => a
#step Int
step
forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper Stepper ()
stepper
stepsToTake :: Int
stepsToTake = Int
n forall a. Num a => a -> a -> a
- Int
step forall a. Num a => a -> a -> a
- Int
1
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep UiVmState
s1 (Int -> StepMode
Step Int
stepsToTake)
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'P') [])) =
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
isNextSourcePosition
appEvent (VtyEvent (V.EvKey (V.KChar Char
'p') [Modifier
V.MCtrl])) =
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
(UiVmState -> Pred VM) -> EventM n UiState ()
backstepUntil UiVmState -> Pred VM
isNextSourcePositionWithoutEntering
appEvent (VtyEvent (V.EvKey (V.KChar Char
'0') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "vm" a => a
#vm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "result" a => a
#result) UiVmState
s of
Just (HandleEffect (Choose (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
contin))) ->
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep (UiVmState
s forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper (forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
contin Bool
True) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiVmState
s.stepper))
(Int -> StepMode
Step Int
1)
Maybe VMResult
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'1') [])) = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ViewVm UiVmState
s ->
case UiVmState
s.vm.result of
Just (HandleEffect (Choose (PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
contin))) ->
forall n.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
UiVmState -> StepMode -> EventM n UiState ()
takeStep (UiVmState
s forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "stepper" a => a
#stepper (forall a. EVM a -> Stepper a
Stepper.evm (Bool -> EVM ()
contin Bool
False) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UiVmState
s.stepper))
(Int -> StepMode
Step Int
1)
Maybe VMResult
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
UiState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appEvent (VtyEvent (V.EvKey (V.KChar Char
'f') [Modifier
V.MCtrl])) =
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage (forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Direction
Down
appEvent (VtyEvent (V.EvKey (V.KChar Char
'b') [Modifier
V.MCtrl])) =
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage (forall n. n -> ViewportScroll n
viewportScroll Name
TracePane) Direction
Up
appEvent (VtyEvent Event
e) = do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf (Prism' UiState UiTestPickerState
_ViewPicker forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "tests" a => a
#tests))
(forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e)
appEvent BrickEvent Name e
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
app :: UnitTestOptions -> App UiState () Name
app :: UnitTestOptions -> App UiState () Name
app UnitTestOptions{Bool
Int
Integer
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
ffiAllowed :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
covMatch :: Maybe Text
solver :: Maybe Text
smtTimeout :: Maybe Natural
maxDepth :: Maybe Int
smtDebug :: Bool
askSmtIters :: Integer
maxIter :: Maybe Integer
verbose :: Maybe Int
solvers :: SolverGroup
rpcInfo :: RpcInfo
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
..} =
let ?fetcher = SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo
?maxIter = Maybe Integer
maxIter
in App
{ appDraw :: UiState -> [Widget Name]
appDraw = UiState -> [Widget Name]
drawUi
, appChooseCursor :: UiState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor
, appHandleEvent :: BrickEvent Name () -> EventM Name UiState ()
appHandleEvent = forall e.
(?fetcher::Fetcher, ?maxIter::Maybe Integer) =>
BrickEvent Name e -> EventM Name UiState ()
appEvent
, appStartEvent :: EventM Name UiState ()
appStartEvent = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, appAttrMap :: UiState -> AttrMap
appAttrMap = forall a b. a -> b -> a
const (Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr [(AttrName, Attr)]
myTheme)
}
initialUiVmStateForTest
:: UnitTestOptions
-> (Text, Text)
-> UiVmState
initialUiVmStateForTest :: UnitTestOptions -> (Text, Text) -> UiVmState
initialUiVmStateForTest opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Integer
Maybe Int
Maybe Integer
Maybe Natural
Maybe (Text, ByteString)
RpcInfo
Maybe Text
Text
SolverGroup
DappInfo
TestVMParams
VM -> VM
ffiAllowed :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
covMatch :: Maybe Text
solver :: Maybe Text
smtTimeout :: Maybe Natural
maxDepth :: Maybe Int
smtDebug :: Bool
askSmtIters :: Integer
maxIter :: Maybe Integer
verbose :: Maybe Int
solvers :: SolverGroup
rpcInfo :: RpcInfo
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
..} (Text
theContractName, Text
theTestName) = VM -> UnitTestOptions -> Stepper () -> UiVmState
initUiVmState VM
vm0 UnitTestOptions
opts Stepper ()
script
where
cd :: (Expr 'Buf, [Prop])
cd = case Test
test of
SymbolicTest Text
_ -> Text -> [AbiType] -> [String] -> Expr 'Buf -> (Expr 'Buf, [Prop])
symCalldata Text
theTestName [AbiType]
types [] (Text -> Expr 'Buf
AbstractBuf Text
"txdata")
Test
_ -> (forall a. HasCallStack => String -> a
error String
"unreachable", forall a. HasCallStack => String -> a
error String
"unreachable")
(Test
test, [AbiType]
types) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Test
test',[AbiType]
_) -> Test -> Text
extractSig Test
test' forall a. Eq a => a -> a -> Bool
== Text
theTestName) forall a b. (a -> b) -> a -> b
$ SolcContract -> [(Test, [AbiType])]
unitTestMethods SolcContract
testContract
testContract :: SolcContract
testContract = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
theContractName DappInfo
dapp.solcByName
vm0 :: VM
vm0 =
UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
testContract
script :: Stepper ()
script = do
forall a. EVM a -> Stepper a
Stepper.evm forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceData -> EVM ()
pushTrace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TraceData
EntryTrace forall a b. (a -> b) -> a -> b
$
Text
"test " forall a. Semigroup a => a -> a -> a
<> Text
theTestName forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
theContractName forall a. Semigroup a => a -> a -> a
<> Text
")"
UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
testContract
case Test
test of
ConcreteTest Text
_ -> do
let args :: AbiValue
args = case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> AbiValue
emptyAbi
Just (Text
sig, ByteString
callData) ->
if Text
theTestName forall a. Eq a => a -> a -> Bool
== Text
sig
then AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType (forall a. [a] -> Vector a
Vec.fromList [AbiType]
types)) ByteString
callData
else AbiValue
emptyAbi
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts Text
theTestName AbiValue
args)
SymbolicTest Text
_ -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UnitTestOptions
-> Text -> (Expr 'Buf, [Prop]) -> Stepper (Expr 'End)
execSymTest UnitTestOptions
opts Text
theTestName (Expr 'Buf, [Prop])
cd)
InvariantTest Text
_ -> do
[Addr]
targets <- UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions
opts
let randomRun :: Stepper (Bool, RLP)
randomRun = UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
theTestName [] [Addr]
targets (forall a. a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
maxDepth)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> Stepper (Bool, RLP)
randomRun
Just (Text
sig, ByteString
cd') ->
if Text
theTestName forall a. Eq a => a -> a -> Bool
== Text
sig
then UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
theTestName (ByteString -> [ExploreTx]
decodeCalls ByteString
cd') [Addr]
targets (forall (t :: * -> *) a. Foldable t => t a -> Int
length (ByteString -> [ExploreTx]
decodeCalls ByteString
cd'))
else Stepper (Bool, RLP)
randomRun
myTheme :: [(AttrName, V.Attr)]
myTheme :: [(AttrName, Attr)]
myTheme =
[ (AttrName
selectedAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.standout)
, (AttrName
dimAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
, (AttrName
borderAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
, (AttrName
wordAttr, Color -> Attr
fg Color
V.yellow)
, (AttrName
boldAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
, (AttrName
activeAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.standout)
]
drawUi :: UiState -> [UiWidget]
drawUi :: UiState -> [Widget Name]
drawUi (ViewVm UiVmState
s) = UiVmState -> [Widget Name]
drawVm UiVmState
s
drawUi (ViewPicker UiTestPickerState
s) = UiTestPickerState -> [Widget Name]
drawTestPicker UiTestPickerState
s
drawUi (ViewContracts UiBrowserState
s) = UiBrowserState -> [Widget Name]
drawVmBrowser UiBrowserState
s
drawUi (ViewHelp UiVmState
_) = [Widget Name]
drawHelpView
drawHelpView :: [UiWidget]
drawHelpView :: [Widget Name]
drawHelpView =
[ forall n. Widget n -> Widget n
center forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n -> Widget n
borderWithLabel forall {n}. Widget n
version forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. Int -> Widget n -> Widget n
padLeftRight Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Int -> Widget n -> Widget n
padTopBottom Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$
String
"Esc Exit the debugger\n\n" forall a. Semigroup a => a -> a -> a
<>
String
"a Step to start\n" forall a. Semigroup a => a -> a -> a
<>
String
"e Step to end\n" forall a. Semigroup a => a -> a -> a
<>
String
"n Step fwds by one instruction\n" forall a. Semigroup a => a -> a -> a
<>
String
"N Step fwds to the next source position\n" forall a. Semigroup a => a -> a -> a
<>
String
"C-n Step fwds to the next source position skipping CALL & CREATE\n" forall a. Semigroup a => a -> a -> a
<>
String
"p Step back by one instruction\n\n" forall a. Semigroup a => a -> a -> a
<>
String
"P Step back to the previous source position\n\n" forall a. Semigroup a => a -> a -> a
<>
String
"C-p Step back to the previous source position skipping CALL & CREATE\n\n" forall a. Semigroup a => a -> a -> a
<>
String
"m Toggle memory pane\n" forall a. Semigroup a => a -> a -> a
<>
String
"0 Choose the branch which does not jump \n" forall a. Semigroup a => a -> a -> a
<>
String
"1 Choose the branch which does jump \n" forall a. Semigroup a => a -> a -> a
<>
String
"Down Step to next entry in the callstack / Scroll memory pane\n" forall a. Semigroup a => a -> a -> a
<>
String
"Up Step to previous entry in the callstack / Scroll memory pane\n" forall a. Semigroup a => a -> a -> a
<>
String
"C-f Page memory pane fwds\n" forall a. Semigroup a => a -> a -> a
<>
String
"C-b Page memory pane back\n\n" forall a. Semigroup a => a -> a -> a
<>
String
"Enter Contracts browser"
]
where
version :: Widget n
version =
forall n. Text -> Widget n
txt Text
"Hevm " forall n. Widget n -> Widget n -> Widget n
<+>
forall n. String -> Widget n
str (Version -> String
showVersion Version
Paths.version) forall n. Widget n -> Widget n -> Widget n
<+>
forall n. Text -> Widget n
txt Text
" - Key bindings"
drawTestPicker :: UiTestPickerState -> [UiWidget]
drawTestPicker :: UiTestPickerState -> [Widget Name]
drawTestPicker UiTestPickerState
ui =
[ forall n. Widget n -> Widget n
center forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Unit tests") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. Int -> Widget n -> Widget n
hLimit Int
80 forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
selected (Text
x, Text
y) ->
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
selected forall a b. (a -> b) -> a -> b
$
forall n. Text -> Widget n
txt Text
" Debug " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text -> Text
contractNamePart Text
x) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
"::" forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
y)
Bool
True
UiTestPickerState
ui.tests
]
drawVmBrowser :: UiBrowserState -> [UiWidget]
drawVmBrowser :: UiBrowserState -> [Widget Name]
drawVmBrowser UiBrowserState
ui =
[ forall n. [Widget n] -> Widget n
hBox
[ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Contracts") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. Int -> Widget n -> Widget n
hLimit Int
60 forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
selected (Addr
k, Contract
c') ->
forall n. Bool -> Widget n -> Widget n
withHighlight Bool
selected forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
[ forall a. a -> Maybe a -> a
fromMaybe Text
"<unknown contract>" forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall {r} {t}. HasField "codehash" r (Expr 'EWord) => r -> t
maybeHash Contract
c') DappInfo
dapp.solcByHash forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.contractName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
, Text
"\n"
, Text
" ", String -> Text
pack (forall a. Show a => a -> String
show Addr
k)
])
Bool
True
UiBrowserState
ui.contracts
, case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall {r} {t}. HasField "codehash" r (Expr 'EWord) => r -> t
maybeHash Contract
c) DappInfo
dapp.solcByHash of
Maybe SolcContract
Nothing ->
forall n. [Widget n] -> Widget n
hBox
[ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Contract information") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox
[ forall n. Text -> Widget n
txt (Text
"Codehash: " forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Contract
c.codehash))
, forall n. Text -> Widget n
txt (Text
"Nonce: " forall a. Semigroup a => a -> a -> a
<> W256 -> Text
showWordExact Contract
c.nonce)
, forall n. Text -> Widget n
txt (Text
"Balance: " forall a. Semigroup a => a -> a -> a
<> W256 -> Text
showWordExact Contract
c.balance)
]
]
Just SolcContract
sol ->
forall n. [Widget n] -> Widget n
hBox
[ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Contract information") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2) forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox
[ forall n. Text -> Widget n
txt Text
"Name: " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text -> Text
contractNamePart SolcContract
sol.contractName)
, forall n. Text -> Widget n
txt Text
"File: " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text -> Text
contractPathPart SolcContract
sol.contractName)
, forall n. Text -> Widget n
txt Text
" "
, forall n. Text -> Widget n
txt Text
"Constructor inputs:"
, forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map SolcContract
sol.constructorInputs forall a b. (a -> b) -> a -> b
$
\(Text
name, AbiType
abiType) -> forall n. Text -> Widget n
txt (Text
" " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> AbiType -> Text
abiTypeSolidity AbiType
abiType)
, forall n. Text -> Widget n
txt Text
"Public methods:"
, forall n. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [a] -> [a]
sort (forall k a. Map k a -> [a]
Map.elems SolcContract
sol.abiMap)) forall a b. (a -> b) -> a -> b
$
\Method
method -> forall n. Text -> Widget n
txt (Text
" " forall a. Semigroup a => a -> a -> a
<> Method
method.methodSignature)
]
, forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Storage slots") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox
(forall a b. (a -> b) -> [a] -> [b]
map forall n. Text -> Widget n
txt (DappInfo -> SolcContract -> [Text]
storageLayout DappInfo
dapp SolcContract
sol))
]
]
]
where
dapp :: DappInfo
dapp = UiBrowserState
ui.vm.testOpts.dapp
(Int
_, (Addr
_, Contract
c)) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement UiBrowserState
ui.contracts
maybeHash :: r -> t
maybeHash r
ch = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. HasCallStack => String -> a
error String
"Internal error: cannot find concrete codehash for partially symbolic code") (Expr 'EWord -> Maybe W256
maybeLitWord r
ch.codehash)
drawVm :: UiVmState -> [UiWidget]
drawVm :: UiVmState -> [Widget Name]
drawVm UiVmState
ui =
[ forall n. Int -> Widget n -> Widget n -> Widget n
ifTallEnough (Int
20 forall a. Num a => a -> a -> a
* Int
4)
( forall n. [Widget n] -> Widget n
vBox
[ forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawBytecodePane UiVmState
ui
, forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawStackPane UiVmState
ui
, UiVmState -> Widget Name
drawSolidityPane UiVmState
ui
, forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawTracePane UiVmState
ui
, forall n. Int -> Widget n -> Widget n
vLimit Int
2 Widget Name
drawHelpBar
]
)
( forall n. [Widget n] -> Widget n
vBox
[ forall n. [Widget n] -> Widget n
hBox
[ forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawBytecodePane UiVmState
ui
, forall n. Int -> Widget n -> Widget n
vLimit Int
20 forall a b. (a -> b) -> a -> b
$ UiVmState -> Widget Name
drawStackPane UiVmState
ui
]
, forall n. [Widget n] -> Widget n
hBox
[ UiVmState -> Widget Name
drawSolidityPane UiVmState
ui
, UiVmState -> Widget Name
drawTracePane UiVmState
ui
]
, forall n. Int -> Widget n -> Widget n
vLimit Int
2 Widget Name
drawHelpBar
]
)
]
drawHelpBar :: UiWidget
drawHelpBar :: Widget Name
drawHelpBar = forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hCenter Widget Name
help
where
help :: Widget Name
help =
forall n. [Widget n] -> Widget n
hBox (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> forall n. Text -> Widget n
txt Text
k forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
dim (forall n. Text -> Widget n
txt (Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
v forall a. Semigroup a => a -> a -> a
<> Text
") "))) [(Text, Text)]
helps)
helps :: [(Text, Text)]
helps =
[
(Text
"n", Text
"step")
, (Text
"p", Text
"step back")
, (Text
"a", Text
"step to start")
, (Text
"e", Text
"step to end")
, (Text
"m", Text
"toggle memory")
, (Text
"Esc", Text
"exit")
, (Text
"h", Text
"more help")
]
stepOneOpcode :: Stepper a -> StateT UiVmState IO ()
stepOneOpcode :: forall a. Stepper a -> StateT UiVmState IO ()
stepOneOpcode Stepper a
restart = do
Int
n <- forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall a. IsLabel "step" a => a
#step
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Integral a => a -> a -> a
`mod` Int
snapshotInterval forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ do
VM
vm <- forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall a. IsLabel "vm" a => a
#vm
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall a. IsLabel "snapshots" a => a
#snapshots (forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
n (VM
vm, forall (f :: * -> *) a. Functor f => f a -> f ()
void Stepper a
restart))
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall a. IsLabel "vm" a => a
#vm (forall s a. State s a -> s -> s
execState EVM ()
exec1)
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall a. IsLabel "step" a => a
#step (forall a. Num a => a -> a -> a
+ Int
1)
isNewTraceAdded
:: UiVmState -> Pred VM
isNewTraceAdded :: UiVmState -> Pred VM
isNewTraceAdded UiVmState
ui VM
vm =
let
currentTraceTree :: [Int]
currentTraceTree = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM -> Forest Trace
traceForest UiVmState
ui.vm
newTraceTree :: [Int]
newTraceTree = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM -> Forest Trace
traceForest VM
vm
in [Int]
currentTraceTree forall a. Eq a => a -> a -> Bool
/= [Int]
newTraceTree
isNextSourcePosition
:: UiVmState -> Pred VM
isNextSourcePosition :: UiVmState -> Pred VM
isNextSourcePosition UiVmState
ui VM
vm =
let dapp :: DappInfo
dapp = UiVmState
ui.testOpts.dapp
initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp UiVmState
ui.vm
in DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm forall a. Eq a => a -> a -> Bool
/= Maybe SrcMap
initialPosition
isNextSourcePositionWithoutEntering
:: UiVmState -> Pred VM
isNextSourcePositionWithoutEntering :: UiVmState -> Pred VM
isNextSourcePositionWithoutEntering UiVmState
ui VM
vm =
let
dapp :: DappInfo
dapp = UiVmState
ui.testOpts.dapp
vm0 :: VM
vm0 = UiVmState
ui.vm
initialPosition :: Maybe SrcMap
initialPosition = DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm0
initialHeight :: Int
initialHeight = forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm0.frames
in
case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
Maybe SrcMap
Nothing ->
Bool
False
Just SrcMap
here ->
let
moved :: Bool
moved = forall a. a -> Maybe a
Just SrcMap
here forall a. Eq a => a -> a -> Bool
/= Maybe SrcMap
initialPosition
deeper :: Bool
deeper = forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm.frames forall a. Ord a => a -> a -> Bool
> Int
initialHeight
boring :: Bool
boring =
case SourceCache -> SrcMap -> Maybe ByteString
srcMapCode DappInfo
dapp.sources SrcMap
here of
Just ByteString
bs ->
ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"contract " ByteString
bs
Maybe ByteString
Nothing ->
Bool
True
in
Bool
moved Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
deeper Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
boring
isExecutionHalted :: UiVmState -> Pred VM
isExecutionHalted :: UiVmState -> Pred VM
isExecutionHalted UiVmState
_ VM
vm = forall a. Maybe a -> Bool
isJust VM
vm.result
currentSrcMap :: DappInfo -> VM -> Maybe SrcMap
currentSrcMap :: DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm = do
Contract
this <- VM -> Maybe Contract
currentContract VM
vm
Int
i <- Contract
this.opIxMap forall a. Storable a => Vector a -> Int -> Maybe a
SVec.!? VM
vm.state.pc
DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Contract
this Int
i
drawStackPane :: UiVmState -> UiWidget
drawStackPane :: UiVmState -> Widget Name
drawStackPane UiVmState
ui =
let
gasText :: Text
gasText = W256 -> Text
showWordExact (forall a b. (Integral a, Num b) => a -> b
num UiVmState
ui.vm.state.gas)
labelText :: Widget Name
labelText = forall n. Text -> Widget n
txt (Text
"Gas available: " forall a. Semigroup a => a -> a -> a
<> Text
gasText forall a. Semigroup a => a -> a -> a
<> Text
"; stack:")
stackList :: GenericList Name Vector (Int, Expr 'EWord)
stackList = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
StackPane (forall a. [a] -> Vector a
Vec.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int)..] (forall (a :: EType). Expr a -> Expr a
simplify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UiVmState
ui.vm.state.stack)) Int
2
in forall n. Widget n -> Widget n
hBorderWithLabel Widget Name
labelText forall n. Widget n -> Widget n -> Widget n
<=>
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
_ (Int
i, Expr 'EWord
w) ->
forall n. [Widget n] -> Widget n
vBox
[ forall n. Bool -> Widget n -> Widget n
withHighlight Bool
True (forall n. String -> Widget n
str (String
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" "))
forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
ourWrap (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Text
prettyIfConcreteWord Expr 'EWord
w)
, forall n. Widget n -> Widget n
dim (forall n. Text -> Widget n
txt (Text
" " forall a. Semigroup a => a -> a -> a
<> case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
w of
Maybe W256
Nothing -> Text
""
Just W256
u -> W256 -> DappInfo -> Text
showWordExplanation W256
u UiVmState
ui.testOpts.dapp))
])
Bool
False
GenericList Name Vector (Int, Expr 'EWord)
stackList
message :: VM -> String
message :: VM -> String
message VM
vm =
case VM
vm.result of
Just (VMSuccess (ConcreteBuf ByteString
msg)) ->
String
"VMSuccess: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
msg)
Just (VMSuccess (Expr 'Buf
msg)) ->
String
"VMSuccess: <symbolicbuffer> " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show Expr 'Buf
msg)
Just (VMFailure (Revert Expr 'Buf
msg)) ->
String
"VMFailure: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show Expr 'Buf
msg)
Just (VMFailure EvmError
err) ->
String
"VMFailure: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show EvmError
err
Just (Unfinished PartialExec
p) ->
String
"Could not continue execution: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PartialExec
p
Just (HandleEffect Effect
e) ->
String
"Handling side effect: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Effect
e
Maybe VMResult
Nothing ->
String
"Executing EVM code in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VM
vm.state.contract
drawBytecodePane :: UiVmState -> UiWidget
drawBytecodePane :: UiVmState -> Widget Name
drawBytecodePane UiVmState
ui =
let
vm :: VM
vm = UiVmState
ui.vm
move :: GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
move = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo forall a b. (a -> b) -> a -> b
$ VM -> Maybe Int
vmOpIx VM
vm
in
forall n. Widget n -> Widget n
hBorderWithLabel (forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ VM -> String
message VM
vm) forall n. Widget n -> Widget n -> Widget n
<=>
forall n e.
(Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> List n e -> Widget n
Centered.renderList
(\Bool
active (Int, Op)
x -> if Bool -> Bool
not Bool
active
then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr (forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget (Int, Op)
x)
else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
boldAttr (forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget (Int, Op)
x))
Bool
False
(GenericList Name Vector (Int, Op)
-> GenericList Name Vector (Int, Op)
move forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
BytecodePane
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (.codeOps) (VM -> Maybe Contract
currentContract VM
vm))
Int
1)
dim :: Widget n -> Widget n
dim :: forall n. Widget n -> Widget n
dim = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr
withHighlight :: Bool -> Widget n -> Widget n
withHighlight :: forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr
withHighlight Bool
True = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
boldAttr
prettyIfConcrete :: Expr Buf -> String
prettyIfConcrete :: Expr 'Buf -> String
prettyIfConcrete (ConcreteBuf ByteString
x) = Int -> ByteString -> String
prettyHex Int
40 ByteString
x
prettyIfConcrete Expr 'Buf
x = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Expr a
simplify Expr 'Buf
x
drawTracePane :: UiVmState -> UiWidget
drawTracePane :: UiVmState -> Widget Name
drawTracePane UiVmState
s =
let vm :: VM
vm = UiVmState
s.vm
dapp :: DappInfo
dapp = UiVmState
s.testOpts.dapp
traceList :: GenericList Name Vector Text
traceList =
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
Name
TracePane
(forall a. [a] -> Vector a
Vec.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DappInfo -> VM -> Text
showTraceTree DappInfo
dapp
forall a b. (a -> b) -> a -> b
$ VM
vm)
Int
1
in case UiVmState
s.showMemory of
Bool
True -> forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
TracePane ViewportType
Vertical forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Calldata")
forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete VM
vm.state.calldata)
forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Returndata")
forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete VM
vm.state.returndata)
forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Output")
forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show VM
vm.result)
forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Cache")
forall n. Widget n -> Widget n -> Widget n
<=> forall n. String -> Widget n
ourWrap (forall a. Show a => a -> String
show VM
vm.cache.path)
forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Path Conditions")
forall n. Widget n -> Widget n -> Widget n
<=> (forall n. String -> Widget n
ourWrap forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ VM
vm.constraints)
forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Memory")
forall n. Widget n -> Widget n -> Widget n
<=> (forall n. String -> Widget n
ourWrap (Expr 'Buf -> String
prettyIfConcrete VM
vm.state.memory))
Bool
False ->
forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Trace")
forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList
(\Bool
_ Text
x -> forall n. Text -> Widget n
txt Text
x)
Bool
False
(forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList Name Vector Text
traceList) GenericList Name Vector Text
traceList)
ourWrap :: String -> Widget n
ourWrap :: forall n. String -> Widget n
ourWrap = forall n. WrapSettings -> String -> Widget n
strWrapWith WrapSettings
settings
where
settings :: WrapSettings
settings = WrapSettings
{ preserveIndentation :: Bool
preserveIndentation = Bool
True
, breakLongWords :: Bool
breakLongWords = Bool
True
, fillStrategy :: FillStrategy
fillStrategy = FillStrategy
NoFill
, fillScope :: FillScope
fillScope = FillScope
FillAfterFirst
}
solidityList :: VM -> DappInfo -> List Name (Int, ByteString)
solidityList :: VM -> DappInfo -> List Name (Int, ByteString)
solidityList VM
vm DappInfo
dapp =
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
SolidityPane
(case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
Maybe SrcMap
Nothing -> forall a. Monoid a => a
mempty
Just SrcMap
x ->
forall a. a -> Maybe a -> a
fromMaybe
(forall a. HasCallStack => String -> a
error String
"Internal Error: unable to find line for source map")
(forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix SrcMap
x.file
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s a. (s -> a) -> Getter s a
to (forall a b. (Int -> a -> b) -> Vector a -> Vector b
Vec.imap (,)))
DappInfo
dapp.sources.lines))
Int
1
drawSolidityPane :: UiVmState -> UiWidget
drawSolidityPane :: UiVmState -> Widget Name
drawSolidityPane UiVmState
ui =
let dapp :: DappInfo
dapp = UiVmState
ui.testOpts.dapp
dappSrcs :: SourceCache
dappSrcs = DappInfo
dapp.sources
vm :: VM
vm = UiVmState
ui.vm
in case DappInfo -> VM -> Maybe SrcMap
currentSrcMap DappInfo
dapp VM
vm of
Maybe SrcMap
Nothing -> forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"<no source map>"))
Just SrcMap
sm ->
let
rows :: Maybe (Vector ByteString)
rows = SourceCache
dappSrcs.lines forall k a. Ord k => Map k a -> k -> Maybe a
!? SrcMap
sm.file
subrange :: Int -> Maybe (Int, Int)
subrange :: Int -> Maybe (Int, Int)
subrange Int
i = do
Vector ByteString
rs <- Maybe (Vector ByteString)
rows
Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange Vector ByteString
rs (SrcMap
sm.offset, SrcMap
sm.length) Int
i
fileName :: Maybe Text
fileName :: Maybe Text
fileName = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DappInfo
dapp.sources.files forall k a. Ord k => Map k a -> k -> Maybe a
!? SrcMap
sm.file)
lineNo :: Maybe Int
lineNo :: Maybe Int
lineNo = ((\Int
a -> forall a. a -> Maybe a
Just (Int
a forall a. Num a => a -> a -> a
- Int
1)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceCache -> SrcMap -> Maybe (String, Int)
srcMapCodePos DappInfo
dapp.sources SrcMap
sm
in forall n. [Widget n] -> Widget n
vBox
[ forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$
forall n. Text -> Widget n
txt (forall a. a -> Maybe a -> a
fromMaybe Text
"<unknown>" Maybe Text
fileName)
forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str (String
":" forall a. [a] -> [a] -> [a]
++ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"?" forall a. Show a => a -> String
show Maybe Int
lineNo))
forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Text
" (" forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Text
"?"
(DappInfo
dapp.astSrcMap SrcMap
sm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String)) forall a. Semigroup a => a -> a -> a
<> Text
")")
, forall n e.
(Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> List n e -> Widget n
Centered.renderList
(\Bool
_ (Int
i, ByteString
line) ->
let s :: Text
s = case ByteString -> Text
decodeUtf8 ByteString
line of Text
"" -> Text
" "; Text
y -> Text
y
in case Int -> Maybe (Int, Int)
subrange Int
i of
Maybe (Int, Int)
Nothing -> forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (forall n. Text -> Widget n
txt Text
s)
Just (Int
a, Int
b) ->
let (Text
x, Text
y, Text
z) = ( Int -> Text -> Text
Text.take Int
a Text
s
, Int -> Text -> Text
Text.take Int
b (Int -> Text -> Text
Text.drop Int
a Text
s)
, Int -> Text -> Text
Text.drop (Int
a forall a. Num a => a -> a -> a
+ Int
b) Text
s
)
in forall n. [Widget n] -> Widget n
hBox [ forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (forall n. Text -> Widget n
txt Text
x)
, forall n. Bool -> Widget n -> Widget n
withHighlight Bool
True (forall n. Text -> Widget n
txt Text
y)
, forall n. Bool -> Widget n -> Widget n
withHighlight Bool
False (forall n. Text -> Widget n
txt Text
z)
])
Bool
False
((forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Maybe Int
lineNo)
(VM -> DappInfo -> List Name (Int, ByteString)
solidityList VM
vm DappInfo
dapp))
]
ifTallEnough :: Int -> Widget n -> Widget n -> Widget n
ifTallEnough :: forall n. Int -> Widget n -> Widget n -> Widget n
ifTallEnough Int
need Widget n
w1 Widget n
w2 =
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
Context n
c <- forall n. RenderM n (Context n)
getContext
if forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall s t a b. LensVL s t a b -> Lens s t a b
lensVL forall n. Lens' (Context n) Int
availHeightL) Context n
c forall a. Ord a => a -> a -> Bool
> Int
need
then forall n. Widget n -> RenderM n (Result n)
render Widget n
w1
else forall n. Widget n -> RenderM n (Result n)
render Widget n
w2
opWidget :: (Integral a, Show a) => (a, Op) -> Widget n
opWidget :: forall a n. (Integral a, Show a) => (a, Op) -> Widget n
opWidget = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => (a, Op) -> String
opString
selectedAttr :: AttrName; selectedAttr :: AttrName
selectedAttr = String -> AttrName
attrName String
"selected"
dimAttr :: AttrName; dimAttr :: AttrName
dimAttr = String -> AttrName
attrName String
"dim"
wordAttr :: AttrName; wordAttr :: AttrName
wordAttr = String -> AttrName
attrName String
"word"
boldAttr :: AttrName; boldAttr :: AttrName
boldAttr = String -> AttrName
attrName String
"bold"
activeAttr :: AttrName; activeAttr :: AttrName
activeAttr = String -> AttrName
attrName String
"active"