{-# Language DataKinds #-}
{-# Language ImplicitParams #-}
module EVM.UnitTest where
import Prelude hiding (Word)
import EVM
import EVM.ABI
import EVM.Concrete
import EVM.SMT
import EVM.Solvers
import EVM.Dapp
import EVM.Debug (srcMapCodePos)
import EVM.Exec
import EVM.Expr (litAddr, readStorage', simplify)
import EVM.Expr qualified as Expr
import EVM.Facts qualified as Facts
import EVM.Facts.Git qualified as Git
import EVM.FeeSchedule qualified as FeeSchedule
import EVM.Fetch qualified as Fetch
import EVM.Format
import EVM.Solidity
import EVM.SymExec (defaultVeriOpts, symCalldata, verify, isQed, extractCex, runExpr, subModel, VeriOpts(..))
import EVM.Types
import EVM.Transaction (initTx)
import EVM.RLP
import EVM.Stepper (Stepper, interpret)
import EVM.Stepper qualified as Stepper
import Control.Monad.Operational qualified as Operational
import Optics.Core hiding (elements)
import Optics.State
import Optics.State.Operators
import Optics.Zoom
import Control.Monad.Par.Class (spawn_)
import Control.Monad.Par.Class qualified as Par
import Control.Monad.Par.IO (runParIO)
import Control.Monad.State.Strict hiding (state)
import Control.Monad.State.Strict qualified as State
import Data.ByteString.Lazy qualified as BSLazy
import Data.Binary.Get (runGet)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Decimal (DecimalRaw(..))
import Data.Either (isRight)
import Data.Foldable (toList)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, catMaybes, fromJust, isJust, fromMaybe, mapMaybe, isNothing)
import Data.MultiSet (MultiSet)
import Data.MultiSet qualified as MultiSet
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (isPrefixOf, stripSuffix, intercalate, Text, pack, unpack)
import Data.Text qualified as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Text.IO qualified as Text
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word32, Word64)
import GHC.Natural
import System.Environment (lookupEnv)
import System.IO (hFlush, stdout)
import Test.QuickCheck hiding (verbose, Success, Failure)
import qualified Test.QuickCheck as QC
data UnitTestOptions = UnitTestOptions
{ UnitTestOptions -> RpcInfo
rpcInfo :: Fetch.RpcInfo
, UnitTestOptions -> SolverGroup
solvers :: SolverGroup
, UnitTestOptions -> Maybe Int
verbose :: Maybe Int
, UnitTestOptions -> Maybe Integer
maxIter :: Maybe Integer
, UnitTestOptions -> Integer
askSmtIters :: Integer
, UnitTestOptions -> Bool
smtDebug :: Bool
, UnitTestOptions -> Maybe Int
maxDepth :: Maybe Int
, UnitTestOptions -> Maybe Natural
smtTimeout :: Maybe Natural
, UnitTestOptions -> Maybe Text
solver :: Maybe Text
, UnitTestOptions -> Maybe Text
covMatch :: Maybe Text
, UnitTestOptions -> Text
match :: Text
, UnitTestOptions -> Int
fuzzRuns :: Int
, UnitTestOptions -> Maybe (Text, ByteString)
replay :: Maybe (Text, BSLazy.ByteString)
, UnitTestOptions -> VM -> VM
vmModifier :: VM -> VM
, UnitTestOptions -> DappInfo
dapp :: DappInfo
, UnitTestOptions -> TestVMParams
testParams :: TestVMParams
, UnitTestOptions -> Bool
ffiAllowed :: Bool
}
data TestVMParams = TestVMParams
{ TestVMParams -> Addr
address :: Addr
, TestVMParams -> Addr
caller :: Addr
, TestVMParams -> Addr
origin :: Addr
, TestVMParams -> Word64
gasCreate :: Word64
, TestVMParams -> Word64
gasCall :: Word64
, TestVMParams -> W256
baseFee :: W256
, TestVMParams -> W256
priorityFee :: W256
, TestVMParams -> W256
balanceCreate :: W256
, TestVMParams -> Addr
coinbase :: Addr
, TestVMParams -> W256
number :: W256
, TestVMParams -> W256
timestamp :: W256
, TestVMParams -> Word64
gaslimit :: Word64
, TestVMParams -> W256
gasprice :: W256
, TestVMParams -> W256
maxCodeSize :: W256
, TestVMParams -> W256
prevrandao :: W256
, TestVMParams -> W256
chainId :: W256
}
defaultGasForCreating :: Word64
defaultGasForCreating :: Word64
defaultGasForCreating = Word64
0xffffffffffff
defaultGasForInvoking :: Word64
defaultGasForInvoking :: Word64
defaultGasForInvoking = Word64
0xffffffffffff
defaultBalanceForTestContract :: W256
defaultBalanceForTestContract :: W256
defaultBalanceForTestContract = W256
0xffffffffffffffffffffffff
defaultMaxCodeSize :: W256
defaultMaxCodeSize :: W256
defaultMaxCodeSize = W256
0xffffffff
type ABIMethod = Text
makeVeriOpts :: UnitTestOptions -> VeriOpts
makeVeriOpts :: UnitTestOptions -> VeriOpts
makeVeriOpts UnitTestOptions
opts =
VeriOpts
defaultVeriOpts { $sel:debug:VeriOpts :: Bool
debug = UnitTestOptions
opts.smtDebug
, $sel:maxIter:VeriOpts :: Maybe Integer
maxIter = UnitTestOptions
opts.maxIter
, $sel:askSmtIters:VeriOpts :: Integer
askSmtIters = UnitTestOptions
opts.askSmtIters
, $sel:rpcInfo:VeriOpts :: RpcInfo
rpcInfo = UnitTestOptions
opts.rpcInfo
}
unitTest :: UnitTestOptions -> Contracts -> Maybe String -> IO Bool
unitTest :: UnitTestOptions -> Contracts -> Maybe FilePath -> IO Bool
unitTest UnitTestOptions
opts (Contracts Map Text SolcContract
cs) Maybe FilePath
cache' = do
let unitTests :: [(Text, [(Test, [AbiType])])]
unitTests = Text -> [SolcContract] -> [(Text, [(Test, [AbiType])])]
findUnitTests UnitTestOptions
opts.match forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (k :: OpticKind) (a :: OpticKind). Map k a -> [a]
Map.elems Map Text SolcContract
cs
[(Bool, VM)]
results <- forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
(a -> m [b]) -> [a] -> m [b]
concatMapM (UnitTestOptions
-> Map Text SolcContract
-> (Text, [(Test, [AbiType])])
-> IO [(Bool, VM)]
runUnitTestContract UnitTestOptions
opts Map Text SolcContract
cs) [(Text, [(Test, [AbiType])])]
unitTests
let ([Bool]
passing, [VM]
vms) = forall (a :: OpticKind) (b :: OpticKind). [(a, b)] -> ([a], [b])
unzip [(Bool, VM)]
results
case Maybe FilePath
cache' of
Maybe FilePath
Nothing ->
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
Just FilePath
path ->
let
evmcache :: Cache
evmcache = forall (a :: OpticKind). Monoid a => [a] -> a
mconcat [VM
vm.cache | VM
vm <- [VM]
vms]
in
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ RepoAt -> Set Fact -> IO ()
Git.saveFacts (FilePath -> RepoAt
Git.RepoAt FilePath
path) (Cache -> Set Fact
Facts.cacheFacts Cache
evmcache)
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (t :: OpticKind -> OpticKind). Foldable t => t Bool -> Bool
and [Bool]
passing
initializeUnitTest :: UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest :: UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
theContract = do
let addr :: Index (Map Addr Contract)
addr = UnitTestOptions
opts.testParams.address
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
(s -> s) -> m ()
modify UnitTestOptions
opts.vmModifier
TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
"constructor")
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
#env % #contracts % ix addr % #balance %= (+ opts.testParams.balanceCreate)
let theAbi = theContract.abiMap
setUp = abiKeccak (encodeUtf8 "setUp()")
when (isJust (Map.lookup setUp theAbi)) $ do
abiCall opts.testParams (Left ("setUp()", emptyAbi))
popTrace
pushTrace (EntryTrace "setUp()")
Either EvmError (Expr 'Buf)
res <- Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ case Either EvmError (Expr 'Buf)
res of
Left EvmError
e -> TraceData -> EVM ()
pushTrace (EvmError -> TraceData
ErrorTrace EvmError
e)
Either EvmError (Expr 'Buf)
_ -> EVM ()
popTrace
runUnitTest :: UnitTestOptions -> ABIMethod -> AbiValue -> Stepper Bool
runUnitTest :: UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
a Text
method AbiValue
args = do
Bool
x <- UnitTestOptions -> Text -> AbiValue -> Stepper Bool
execTestStepper UnitTestOptions
a Text
method AbiValue
args
UnitTestOptions -> Text -> Bool -> Stepper Bool
checkFailures UnitTestOptions
a Text
method Bool
x
execTestStepper :: UnitTestOptions -> ABIMethod -> AbiValue -> Stepper Bool
execTestStepper :: UnitTestOptions -> Text -> AbiValue -> Stepper Bool
execTestStepper 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
.. } Text
methodName' AbiValue
method = do
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams (forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (Text
methodName', AbiValue
method))
TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
methodName')
Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Left EvmError
e -> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm (TraceData -> EVM ()
pushTrace (EvmError -> TraceData
ErrorTrace EvmError
e) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> EVM ()
popTrace) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
True
Either EvmError (Expr 'Buf)
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
False
exploreStep :: UnitTestOptions -> ByteString -> Stepper Bool
exploreStep :: UnitTestOptions -> ByteString -> Stepper Bool
exploreStep 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} ByteString
bs = do
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Map Addr Contract
cs <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "contracts" a => a
#contracts)
TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams (forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right ByteString
bs)
let (Method [(Text, AbiType)]
_ [(Text, AbiType)]
inputs Text
sig Text
_ Mutability
_) = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"unknown abi call") forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs) DappInfo
dapp.abiMap
types :: [AbiType]
types = forall (a :: OpticKind) (b :: OpticKind). (a, b) -> b
snd forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [(Text, AbiType)]
inputs
let ?context = DappInfo -> Map Addr Contract -> DappContext
DappContext DappInfo
dapp Map Addr Contract
cs
IxValue (Map Addr Contract)
this <- forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"unknown target") forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> (forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at TestVMParams
testParams.address))
let name :: Text
name = forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text
contractNamePart forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (.contractName)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ContractCode -> DappInfo -> Maybe SolcContract
lookupCode IxValue (Map Addr Contract)
this.contractcode DappInfo
dapp
TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace (Text
name forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"." forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
sig forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"(" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," ((FilePath -> Text
pack forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> FilePath
show) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [AbiType]
types) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall [AbiType]
types (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs)))
Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Left EvmError
e -> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm (TraceData -> EVM ()
pushTrace (EvmError -> TraceData
ErrorTrace EvmError
e) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> EVM ()
popTrace) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
True
Either EvmError (Expr 'Buf)
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
False
checkFailures :: UnitTestOptions -> ABIMethod -> Bool -> Stepper Bool
checkFailures :: UnitTestOptions -> Text -> Bool -> Stepper Bool
checkFailures 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
.. } Text
method Bool
bailed = do
let shouldFail :: Bool
shouldFail = Text
"testFail" Text -> Text -> Bool
`isPrefixOf` Text
method
if Bool
bailed then
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
shouldFail
else do
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
EVM ()
popTrace
TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (Text
"failed()", AbiValue
emptyAbi)
Either EvmError (Expr 'Buf)
res <- Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully
case Either EvmError (Expr 'Buf)
res of
Right (ConcreteBuf ByteString
r) ->
let failed :: Bool
failed = case AbiType -> ByteString -> AbiValue
decodeAbiValue AbiType
AbiBoolType (ByteString -> ByteString
BSLazy.fromStrict ByteString
r) of
AbiBool Bool
f -> Bool
f
AbiValue
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"fix me with better types"
in forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Bool
shouldFail forall (a :: OpticKind). Eq a => a -> a -> Bool
== Bool
failed)
Either EvmError (Expr 'Buf)
c -> forall a. HasCallStack => FilePath -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"internal error: unexpected failure code: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> FilePath
show Either EvmError (Expr 'Buf)
c
fuzzTest :: UnitTestOptions -> Text -> [AbiType] -> VM -> Property
fuzzTest :: UnitTestOptions -> Text -> [AbiType] -> VM -> Property
fuzzTest 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} Text
sig [AbiType]
types VM
vm = forall (prop :: OpticKind) (a :: OpticKind).
Testable prop =>
Gen a -> (a -> FilePath) -> (a -> prop) -> Property
forAllShow (AbiType -> Gen AbiValue
genAbiValue (Vector AbiType -> AbiType
AbiTupleType forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). [a] -> Vector a
Vector.fromList [AbiType]
types)) (forall (a :: OpticKind). Show a => a -> FilePath
show forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringS
ByteStringS forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. AbiValue -> ByteString
encodeAbiValue)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \AbiValue
args -> forall (prop :: OpticKind). Testable prop => IO prop -> Property
ioProperty forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret (SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) VM
vm (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts Text
sig AbiValue
args)
tick :: Text -> IO ()
tick :: Text -> IO ()
tick Text
x = Text -> IO ()
Text.putStr Text
x forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
data OpLocation = OpLocation
{ OpLocation -> Contract
srcContract :: Contract
, OpLocation -> Int
srcOpIx :: Int
} deriving (Int -> OpLocation -> ShowS
[OpLocation] -> ShowS
OpLocation -> FilePath
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OpLocation] -> ShowS
$cshowList :: [OpLocation] -> ShowS
show :: OpLocation -> FilePath
$cshow :: OpLocation -> FilePath
showsPrec :: Int -> OpLocation -> ShowS
$cshowsPrec :: Int -> OpLocation -> ShowS
Show)
instance Eq OpLocation where
== :: OpLocation -> OpLocation -> Bool
(==) (OpLocation Contract
a Int
b) (OpLocation Contract
a' Int
b') = Int
b forall (a :: OpticKind). Eq a => a -> a -> Bool
== Int
b' Bool -> Bool -> Bool
&& Contract
a.contractcode forall (a :: OpticKind). Eq a => a -> a -> Bool
== Contract
a'.contractcode
instance Ord OpLocation where
compare :: OpLocation -> OpLocation -> Ordering
compare (OpLocation Contract
a Int
b) (OpLocation Contract
a' Int
b') = forall (a :: OpticKind). Ord a => a -> a -> Ordering
compare (Contract
a.contractcode, Int
b) (Contract
a'.contractcode, Int
b')
srcMapForOpLocation :: DappInfo -> OpLocation -> Maybe SrcMap
srcMapForOpLocation :: DappInfo -> OpLocation -> Maybe SrcMap
srcMapForOpLocation DappInfo
dapp (OpLocation Contract
contr Int
opIx) = DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Contract
contr Int
opIx
type CoverageState = (VM, MultiSet OpLocation)
currentOpLocation :: VM -> OpLocation
currentOpLocation :: VM -> OpLocation
currentOpLocation VM
vm =
case VM -> Maybe Contract
currentContract VM
vm of
Maybe Contract
Nothing ->
forall a. HasCallStack => FilePath -> a
error FilePath
"internal error: why no contract?"
Just Contract
c ->
Contract -> Int -> OpLocation
OpLocation
Contract
c
(forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"internal error: op ix") (VM -> Maybe Int
vmOpIx VM
vm))
execWithCoverage :: StateT CoverageState IO VMResult
execWithCoverage :: StateT CoverageState IO VMResult
execWithCoverage = do VM
_ <- StateT CoverageState IO VM
runWithCoverage
forall (a :: OpticKind). HasCallStack => Maybe a -> a
fromJust forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "result" a => a
#result)
runWithCoverage :: StateT CoverageState IO VM
runWithCoverage :: StateT CoverageState IO VM
runWithCoverage = do
VM
vm0 <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1
case VM
vm0.result of
Maybe VMResult
Nothing -> do
VM
vm1 <- forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 (forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
(s -> (a, s)) -> m a
State.state (forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> (a, s)
runState EVM ()
exec1) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get)
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field2 s t a b =>
Lens s t a b
_2 (forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
(s -> s) -> m ()
modify (forall (a :: OpticKind). Ord a => a -> MultiSet a -> MultiSet a
MultiSet.insert (VM -> OpLocation
currentOpLocation VM
vm1)))
StateT CoverageState IO VM
runWithCoverage
Just VMResult
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure VM
vm0
interpretWithCoverage
:: UnitTestOptions
-> Stepper a
-> StateT CoverageState IO a
interpretWithCoverage :: forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} =
forall (a :: OpticKind).
ProgramView Action a -> StateT CoverageState IO a
eval forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (instr :: OpticKind -> OpticKind) (a :: OpticKind).
Program instr a -> ProgramView instr a
Operational.view
where
eval
:: Operational.ProgramView Stepper.Action a
-> StateT CoverageState IO a
eval :: forall (a :: OpticKind).
ProgramView Action a -> StateT CoverageState IO a
eval (Operational.Return a
x) =
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure a
x
eval (Action b
action Operational.:>>= b -> ProgramT Action Identity a
k) =
case Action b
action of
Action b
Stepper.Exec ->
StateT CoverageState IO VMResult
execWithCoverage forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
Action b
Stepper.Run ->
StateT CoverageState IO VM
runWithCoverage forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
Stepper.Wait (PleaseAskSMT (Lit W256
c) [Prop]
_ BranchCondition -> EVM ()
continue) ->
forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm (BranchCondition -> EVM ()
continue (Bool -> BranchCondition
Case (W256
c forall (a :: OpticKind). Ord a => a -> a -> Bool
> W256
0))) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= b -> ProgramT Action Identity a
k)
Stepper.Wait Query
q ->
do EVM ()
m <- forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO ((SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) Query
q)
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 (forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
(s -> (a, s)) -> m a
State.state (forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> (a, s)
runState EVM ()
m)) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (b -> ProgramT Action Identity a
k ())
Stepper.Ask Choose
_ ->
forall a. HasCallStack => FilePath -> a
error FilePath
"cannot make choice in this interpreter"
Stepper.IOAct StateT VM IO b
q ->
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 (forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
(s -> m (a, s)) -> StateT s m a
StateT (forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
StateT s m a -> s -> m (a, s)
runStateT StateT VM IO b
q)) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
Stepper.EVM EVM b
m ->
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 (forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
(s -> (a, s)) -> m a
State.state (forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> (a, s)
runState EVM b
m)) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
coverageReport
:: DappInfo
-> MultiSet SrcMap
-> Map FilePath (Vector (Int, ByteString))
coverageReport :: DappInfo
-> MultiSet SrcMap -> Map FilePath (Vector (Int, ByteString))
coverageReport DappInfo
dapp MultiSet SrcMap
cov =
let
sources :: SourceCache
sources :: SourceCache
sources = DappInfo
dapp.sources
allPositions :: Set (FilePath, Int)
allPositions :: Set (FilePath, Int)
allPositions =
( forall (a :: OpticKind). Ord a => [a] -> Set a
Set.fromList
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind) (b :: OpticKind).
(a -> Maybe b) -> [a] -> [b]
mapMaybe (SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos SourceCache
sources)
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Monoid a => [a] -> a
mconcat
( DappInfo
dapp.solcByName
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (a :: OpticKind). Map k a -> [a]
Map.elems
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (\SolcContract
x -> SolcContract
x.runtimeSrcmap forall (a :: OpticKind). Semigroup a => a -> a -> a
<> SolcContract
x.creationSrcmap)
)
)
srcMapCov :: MultiSet (FilePath, Int)
srcMapCov :: MultiSet (FilePath, Int)
srcMapCov = forall (b :: OpticKind) (a :: OpticKind).
Ord b =>
(a -> Maybe b) -> MultiSet a -> MultiSet b
MultiSet.mapMaybe (SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos SourceCache
sources) MultiSet SrcMap
cov
linesByName :: Map FilePath (Vector ByteString)
linesByName :: Map FilePath (Vector ByteString)
linesByName =
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
[(k, a)] -> Map k a
Map.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(FilePath
name, ByteString
_) Vector ByteString
lines' -> (FilePath
name, Vector ByteString
lines'))
(forall (k :: OpticKind) (a :: OpticKind). Map k a -> [a]
Map.elems SourceCache
sources.files)
(forall (k :: OpticKind) (a :: OpticKind). Map k a -> [a]
Map.elems SourceCache
sources.lines)
f :: FilePath -> Vector ByteString -> Vector (Int, ByteString)
f :: FilePath -> Vector ByteString -> Vector (Int, ByteString)
f FilePath
name =
forall (a :: OpticKind) (b :: OpticKind).
(Int -> a -> b) -> Vector a -> Vector b
Vector.imap
(\Int
i ByteString
bs ->
let
n :: Int
n =
if forall (a :: OpticKind). Ord a => a -> Set a -> Bool
Set.member (FilePath
name, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1) Set (FilePath, Int)
allPositions
then forall (a :: OpticKind). Ord a => a -> MultiSet a -> Int
MultiSet.occur (FilePath
name, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1) MultiSet (FilePath, Int)
srcMapCov
else -Int
1
in (Int
n, ByteString
bs))
in
forall (k :: OpticKind) (a :: OpticKind) (b :: OpticKind).
(k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey FilePath -> Vector ByteString -> Vector (Int, ByteString)
f Map FilePath (Vector ByteString)
linesByName
coverageForUnitTestContract
:: UnitTestOptions
-> Map Text SolcContract
-> SourceCache
-> (Text, [(Test, [AbiType])])
-> IO (MultiSet SrcMap)
coverageForUnitTestContract :: UnitTestOptions
-> Map Text SolcContract
-> SourceCache
-> (Text, [(Test, [AbiType])])
-> IO (MultiSet SrcMap)
coverageForUnitTestContract
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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..}) Map Text SolcContract
contractMap SourceCache
_ (Text
name, [(Test, [AbiType])]
testNames) = do
case forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup Text
name Map Text SolcContract
contractMap of
Maybe SolcContract
Nothing ->
forall a. HasCallStack => FilePath -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"Contract " forall (a :: OpticKind). [a] -> [a] -> [a]
++ Text -> FilePath
unpack Text
name forall (a :: OpticKind). [a] -> [a] -> [a]
++ FilePath
" not found"
Just SolcContract
theContract -> do
let vm0 :: VM
vm0 = UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
theContract
(VM
vm1, MultiSet OpLocation
cov1) <-
forall (m :: OpticKind -> OpticKind) (s :: OpticKind)
(a :: OpticKind).
Monad m =>
StateT s m a -> s -> m s
execStateT
(forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts
(Text -> Stepper ()
Stepper.enter Text
name forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
theContract))
(VM
vm0, forall (a :: OpticKind). Monoid a => a
mempty)
let
runOne' :: (Test, [AbiType]) -> ParIO (IVar (MultiSet OpLocation))
runOne' (Test
test, [AbiType]
_) = forall (future :: OpticKind -> OpticKind)
(m :: OpticKind -> OpticKind) (a :: OpticKind).
ParFuture future m =>
m a -> m (future a)
spawn_ forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(Bool
_, (VM
_, MultiSet OpLocation
cov)) <-
forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
StateT s m a -> s -> m (a, s)
runStateT
(forall (a :: OpticKind).
UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts (Test -> Text
extractSig Test
test) AbiValue
emptyAbi))
(VM
vm1, forall (a :: OpticKind). Monoid a => a
mempty)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure MultiSet OpLocation
cov
[MultiSet OpLocation]
covs <-
forall (a :: OpticKind). ParIO a -> IO a
runParIO (forall (t :: OpticKind -> OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind) (b :: OpticKind).
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Test, [AbiType]) -> ParIO (IVar (MultiSet OpLocation))
runOne' [(Test, [AbiType])]
testNames forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (t :: OpticKind -> OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind) (b :: OpticKind).
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (future :: OpticKind -> OpticKind)
(m :: OpticKind -> OpticKind) (a :: OpticKind).
ParFuture future m =>
future a -> m a
Par.get)
let cov2 :: MultiSet OpLocation
cov2 = forall (a :: OpticKind). Ord a => [MultiSet a] -> MultiSet a
MultiSet.unions (MultiSet OpLocation
cov1 forall (a :: OpticKind). a -> [a] -> [a]
: [MultiSet OpLocation]
covs)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (forall (b :: OpticKind) (a :: OpticKind).
Ord b =>
(a -> Maybe b) -> MultiSet a -> MultiSet b
MultiSet.mapMaybe (DappInfo -> OpLocation -> Maybe SrcMap
srcMapForOpLocation DappInfo
dapp) MultiSet OpLocation
cov2)
runUnitTestContract
:: UnitTestOptions
-> Map Text SolcContract
-> (Text, [(Test, [AbiType])])
-> IO [(Bool, VM)]
runUnitTestContract :: UnitTestOptions
-> Map Text SolcContract
-> (Text, [(Test, [AbiType])])
-> IO [(Bool, VM)]
runUnitTestContract
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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..}) Map Text SolcContract
contractMap (Text
name, [(Test, [AbiType])]
testSigs) = do
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"Running " forall (a :: OpticKind). [a] -> [a] -> [a]
++ forall (a :: OpticKind). Show a => a -> FilePath
show (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [(Test, [AbiType])]
testSigs) forall (a :: OpticKind). [a] -> [a] -> [a]
++ FilePath
" tests for "
forall (a :: OpticKind). [a] -> [a] -> [a]
++ Text -> FilePath
unpack Text
name
case forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup Text
name Map Text SolcContract
contractMap of
Maybe SolcContract
Nothing ->
forall a. HasCallStack => FilePath -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"Contract " forall (a :: OpticKind). [a] -> [a] -> [a]
++ Text -> FilePath
unpack Text
name forall (a :: OpticKind). [a] -> [a] -> [a]
++ FilePath
" not found"
Just SolcContract
theContract -> do
let vm0 :: VM
vm0 = UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
theContract
VM
vm1 <- forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret (SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) VM
vm0 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Text -> Stepper ()
Stepper.enter Text
name
UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
theContract
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
case VM
vm1.result of
Just (VMFailure EvmError
_) -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Text -> IO ()
Text.putStrLn Text
"\x1b[31m[BAIL]\x1b[0m setUp() "
Text -> IO ()
tick Text
"\n"
Text -> IO ()
tick (FilePath -> Text
Data.Text.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Show a => a -> FilePath
show forall (a :: OpticKind) b. (a -> b) -> a -> b
$ VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm1 UnitTestOptions
opts Text
"setUp()")
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure [(Bool
False, VM
vm1)]
Just (VMSuccess Expr 'Buf
_) -> do
let
runCache :: ([(Either Text Text, VM)], VM) -> (Test, [AbiType])
-> IO ([(Either Text Text, VM)], VM)
runCache :: ([(Either Text Text, VM)], VM)
-> (Test, [AbiType]) -> IO ([(Either Text Text, VM)], VM)
runCache ([(Either Text Text, VM)]
results, VM
vm) (Test
test, [AbiType]
types) = do
(Text
t, Either Text Text
r, VM
vm') <- UnitTestOptions
-> VM -> (Test, [AbiType]) -> IO (Text, Either Text Text, VM)
runTest UnitTestOptions
opts VM
vm (Test
test, [AbiType]
types)
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
t
let vmCached :: VM
vmCached = VM
vm { $sel:cache:VM :: Cache
cache = VM
vm'.cache }
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (((Either Text Text
r, VM
vm')forall (a :: OpticKind). a -> [a] -> [a]
: [(Either Text Text, VM)]
results), VM
vmCached)
([(Either Text Text, VM)]
details, VM
_) <- forall (t :: OpticKind -> OpticKind) (m :: OpticKind -> OpticKind)
(b :: OpticKind) (a :: OpticKind).
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([(Either Text Text, VM)], VM)
-> (Test, [AbiType]) -> IO ([(Either Text Text, VM)], VM)
runCache ([], VM
vm1) [(Test, [AbiType])]
testSigs
let running :: [Text]
running = [Text
x | (Right Text
x, VM
_) <- [(Either Text Text, VM)]
details]
let bailing :: [Text]
bailing = [Text
x | (Left Text
x, VM
_) <- [(Either Text Text, VM)]
details]
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Text -> IO ()
tick Text
"\n"
Text -> IO ()
tick ([Text] -> Text
Text.unlines (forall (a :: OpticKind). (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
running))
Text -> IO ()
tick ([Text] -> Text
Text.unlines [Text]
bailing)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure [(forall (a :: OpticKind) (b :: OpticKind). Either a b -> Bool
isRight Either Text Text
r, VM
vm) | (Either Text Text
r, VM
vm) <- [(Either Text Text, VM)]
details]
Maybe VMResult
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"internal error: setUp() did not end with a result"
runTest :: UnitTestOptions -> VM -> (Test, [AbiType]) -> IO (Text, Either Text Text, VM)
runTest :: UnitTestOptions
-> VM -> (Test, [AbiType]) -> IO (Text, Either Text Text, VM)
runTest opts :: UnitTestOptions
opts@UnitTestOptions{} VM
vm (ConcreteTest Text
testName, []) = forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ UnitTestOptions
-> VM -> Text -> AbiValue -> IO (Text, Either Text Text, VM)
runOne UnitTestOptions
opts VM
vm Text
testName AbiValue
emptyAbi
runTest 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
vm (ConcreteTest Text
testName, [AbiType]
types) = forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing ->
UnitTestOptions
-> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
fuzzRun UnitTestOptions
opts VM
vm Text
testName [AbiType]
types
Just (Text
sig, ByteString
callData) ->
if Text
sig forall (a :: OpticKind). Eq a => a -> a -> Bool
== Text
testName
then UnitTestOptions
-> VM -> Text -> AbiValue -> IO (Text, Either Text Text, VM)
runOne UnitTestOptions
opts VM
vm Text
testName forall (a :: OpticKind) b. (a -> b) -> a -> b
$
AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType (forall (a :: OpticKind). [a] -> Vector a
Vector.fromList [AbiType]
types)) ByteString
callData
else UnitTestOptions
-> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
fuzzRun UnitTestOptions
opts VM
vm Text
testName [AbiType]
types
runTest 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
vm (InvariantTest Text
testName, []) = forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ case Maybe (Text, ByteString)
replay of
Maybe (Text, ByteString)
Nothing -> UnitTestOptions
-> VM -> Text -> [ExploreTx] -> IO (Text, Either Text Text, VM)
exploreRun UnitTestOptions
opts VM
vm Text
testName []
Just (Text
sig, ByteString
cds) ->
if Text
sig forall (a :: OpticKind). Eq a => a -> a -> Bool
== Text
testName
then UnitTestOptions
-> VM -> Text -> [ExploreTx] -> IO (Text, Either Text Text, VM)
exploreRun UnitTestOptions
opts VM
vm Text
testName (ByteString -> [ExploreTx]
decodeCalls ByteString
cds)
else UnitTestOptions
-> VM -> Text -> [ExploreTx] -> IO (Text, Either Text Text, VM)
exploreRun UnitTestOptions
opts VM
vm Text
testName []
runTest UnitTestOptions
_ VM
_ (InvariantTest Text
_, [AbiType]
types) = forall a. HasCallStack => FilePath -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"invariant testing with arguments: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> FilePath
show [AbiType]
types forall (a :: OpticKind). Semigroup a => a -> a -> a
<> FilePath
" is not implemented (yet!)"
runTest UnitTestOptions
opts VM
vm (SymbolicTest Text
testName, [AbiType]
types) = UnitTestOptions
-> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
symRun UnitTestOptions
opts VM
vm Text
testName [AbiType]
types
type ExploreTx = (Addr, Addr, ByteString, W256)
decodeCalls :: BSLazy.ByteString -> [ExploreTx]
decodeCalls :: ByteString -> [ExploreTx]
decodeCalls ByteString
b = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"could not decode replay data") forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
List [RLP]
v <- ByteString -> Maybe RLP
rlpdecode forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSLazy.toStrict ByteString
b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall {a :: OpticKind} {b :: OpticKind}.
(Num a, Num b) =>
RLP -> (a, b, ByteString, W256)
unList forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [RLP]
v
where
unList :: RLP -> (a, b, ByteString, W256)
unList (List [BS ByteString
caller', BS ByteString
target, BS ByteString
cd, BS ByteString
ts]) =
(forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (ByteString -> W256
word ByteString
caller'), forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (ByteString -> W256
word ByteString
target), ByteString
cd, ByteString -> W256
word ByteString
ts)
unList RLP
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"fix me with better types"
initialExplorationStepper :: UnitTestOptions -> ABIMethod -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper :: UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts'' Text
testName [ExploreTx]
replayData [Addr]
targets Int
i = do
let history :: RLP
history = [RLP] -> RLP
List []
Bool
x <- UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts'' Text
testName AbiValue
emptyAbi
if Bool
x
then UnitTestOptions
-> Text
-> [ExploreTx]
-> [Addr]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
opts'' Text
testName [ExploreTx]
replayData [Addr]
targets RLP
history Int
i
else forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Bool
False, RLP
history)
explorationStepper :: UnitTestOptions -> ABIMethod -> [ExploreTx] -> [Addr] -> RLP -> Int -> Stepper (Bool, RLP)
explorationStepper :: UnitTestOptions
-> Text
-> [ExploreTx]
-> [Addr]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
_ Text
_ [ExploreTx]
_ [Addr]
_ RLP
history Int
0 = forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Bool
True, RLP
history)
explorationStepper 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} Text
testName [ExploreTx]
replayData [Addr]
targets (List [RLP]
history) Int
i = do
(Addr
caller', Addr
target, ByteString
cd, W256
timestamp') <-
case forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (Int
i forall (a :: OpticKind). Num a => a -> a -> a
- Int
1)) [ExploreTx]
replayData of
Just ExploreTx
v -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return ExploreTx
v
Maybe ExploreTx
Nothing ->
forall (a :: OpticKind). StateT VM IO a -> Stepper a
Stepper.evmIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let cs :: Map Addr Contract
cs = VM
vm.env.contracts
noCode :: r -> Bool
noCode r
c = case r
c.contractcode of
RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
True
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
c') -> forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null Vector (Expr 'Byte)
c'
ContractCode
_ -> Bool
False
mutable :: r -> Bool
mutable r
m = r
m.mutability forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Mutability
NonPayable, Mutability
Payable]
knownAbis :: Map Addr SolcContract
knownAbis :: Map Addr SolcContract
knownAbis =
forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (.runtimeCode)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter forall {r :: OpticKind}.
HasField "mutability" r Mutability =>
r -> Bool
mutable forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (.abiMap)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter (forall (a :: OpticKind). Maybe a -> Bool
isNothing forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix FunctionSelector
unitTestMarkerAbi) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (.abiMap)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap forall (a :: OpticKind). HasCallStack => Maybe a -> a
fromJust (forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter forall (a :: OpticKind). Maybe a -> Bool
isJust forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
[(k, a)] -> Map k a
Map.fromList [(Addr
addr, ContractCode -> DappInfo -> Maybe SolcContract
lookupCode Contract
c.contractcode DappInfo
dapp) | (Addr
addr, Contract
c) <- forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList Map Addr Contract
cs])
selected :: [(Addr, SolcContract)]
selected = [(Addr
addr,
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error (FilePath
"no src found for: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> FilePath
show Addr
addr)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"contract not found: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> FilePath
show Addr
addr) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup Addr
addr Map Addr Contract
cs).contractcode DappInfo
dapp)
| Addr
addr <- [Addr]
targets]
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
IO a -> m a
liftIO forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(Addr
target, SolcContract
solcInfo) <- forall (a :: OpticKind). Gen a -> IO a
generate forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). [a] -> Gen a
elements (if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null [Addr]
targets then forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList Map Addr SolcContract
knownAbis else [(Addr, SolcContract)]
selected)
(FunctionSelector
_, (Method [(Text, AbiType)]
_ [(Text, AbiType)]
inputs Text
sig Text
_ Mutability
_)) <- forall (a :: OpticKind). Gen a -> IO a
generate (forall (a :: OpticKind). [a] -> Gen a
elements forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter forall {r :: OpticKind}.
HasField "mutability" r Mutability =>
r -> Bool
mutable SolcContract
solcInfo.abiMap)
let types :: [AbiType]
types = forall (a :: OpticKind) (b :: OpticKind). (a, b) -> b
snd forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [(Text, AbiType)]
inputs
let knownEOAs :: [Addr]
knownEOAs = forall (k :: OpticKind) (a :: OpticKind). Map k a -> [k]
Map.keys forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (k :: OpticKind).
(a -> Bool) -> Map k a -> Map k a
Map.filter forall {r :: OpticKind}.
HasField "contractcode" r ContractCode =>
r -> Bool
noCode Map Addr Contract
cs
AbiAddress Addr
caller' <-
if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null [Addr]
knownEOAs
then forall (a :: OpticKind). Gen a -> IO a
generate forall (a :: OpticKind) b. (a -> b) -> a -> b
$ AbiType -> Gen AbiValue
genAbiValue AbiType
AbiAddressType
else forall (a :: OpticKind). Gen a -> IO a
generate forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). [(Int, Gen a)] -> Gen a
frequency
[ (Int
90, AbiType -> Gen AbiValue
genAbiValue AbiType
AbiAddressType)
, (Int
10, Addr -> AbiValue
AbiAddress forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (a :: OpticKind). [a] -> Gen a
elements [Addr]
knownEOAs)
]
AbiValue
args <- forall (a :: OpticKind). Gen a -> IO a
generate forall (a :: OpticKind) b. (a -> b) -> a -> b
$ AbiType -> Gen AbiValue
genAbiValue (Vector AbiType -> AbiType
AbiTupleType forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). [a] -> Vector a
Vector.fromList [AbiType]
types)
let cd :: ByteString
cd = Text -> AbiValue -> ByteString
abiMethod (Text
sig forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"(" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," ((FilePath -> Text
pack forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> FilePath
show) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [AbiType]
types) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")") AbiValue
args
W256
timepassed <- forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (a :: OpticKind). Gen a -> IO a
generate (forall (a :: OpticKind). Integral a => Gen a
arbitrarySizedNatural :: Gen Word32)
let ts :: W256
ts = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"symbolic timestamp not supported here") forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'EWord -> Maybe W256
maybeLitWord VM
vm.block.timestamp
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Addr
caller', Addr
target, ByteString
cd, forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
ts forall (a :: OpticKind). Num a => a -> a -> a
+ W256
timepassed)
let opts' :: UnitTestOptions
opts' = UnitTestOptions
opts { $sel:testParams:UnitTestOptions :: TestVMParams
testParams = TestVMParams
testParams {$sel:address:TestVMParams :: Addr
address = Addr
target, $sel:caller:TestVMParams :: Addr
caller = Addr
caller', $sel:timestamp:TestVMParams :: W256
timestamp = W256
timestamp'}}
thisCallRLP :: RLP
thisCallRLP = [RLP] -> RLP
List [ByteString -> RLP
BS forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> ByteString
word160Bytes Addr
caller', ByteString -> RLP
BS forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> ByteString
word160Bytes Addr
target, ByteString -> RLP
BS ByteString
cd, ByteString -> RLP
BS forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> ByteString
word256Bytes W256
timestamp']
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "block" a => a
#block forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "timestamp" a => a
#timestamp) (W256 -> Expr 'EWord
Lit W256
timestamp')
Bool
bailed <- UnitTestOptions -> ByteString -> Stepper Bool
exploreStep UnitTestOptions
opts' ByteString
cd
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm EVM ()
popTrace
let newHistory :: RLP
newHistory = if Bool
bailed then [RLP] -> RLP
List [RLP]
history else [RLP] -> RLP
List (RLP
thisCallRLPforall (a :: OpticKind). a -> [a] -> [a]
:[RLP]
history)
opts'' :: UnitTestOptions
opts'' = UnitTestOptions
opts {$sel:testParams:UnitTestOptions :: TestVMParams
testParams = TestVMParams
testParams {$sel:timestamp:TestVMParams :: W256
timestamp = W256
timestamp'}}
carryOn :: Stepper (Bool, RLP)
carryOn = UnitTestOptions
-> Text
-> [ExploreTx]
-> [Addr]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
opts'' Text
testName [ExploreTx]
replayData [Addr]
targets RLP
newHistory (Int
i forall (a :: OpticKind). Num a => a -> a -> a
- Int
1)
if Bool
bailed
then Stepper (Bool, RLP)
carryOn
else
do Bool
x <- UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts'' Text
testName AbiValue
emptyAbi
if Bool
x
then Stepper (Bool, RLP)
carryOn
else forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Bool
False, [RLP] -> RLP
List (RLP
thisCallRLPforall (a :: OpticKind). a -> [a] -> [a]
:[RLP]
history))
explorationStepper UnitTestOptions
_ Text
_ [ExploreTx]
_ [Addr]
_ RLP
_ Int
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"malformed rlp"
getTargetContracts :: UnitTestOptions -> Stepper [Addr]
getTargetContracts :: UnitTestOptions -> Stepper [Addr]
getTargetContracts 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} = do
VM
vm <- forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let contract' :: Contract
contract' = forall (a :: OpticKind). HasCallStack => Maybe a -> a
fromJust forall (a :: OpticKind) b. (a -> b) -> a -> b
$ VM -> Maybe Contract
currentContract VM
vm
theAbi :: Map FunctionSelector Method
theAbi = (forall (a :: OpticKind). HasCallStack => Maybe a -> a
fromJust forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ContractCode -> DappInfo -> Maybe SolcContract
lookupCode Contract
contract'.contractcode DappInfo
dapp).abiMap
setUp :: FunctionSelector
setUp = ByteString -> FunctionSelector
abiKeccak (Text -> ByteString
encodeUtf8 Text
"targetContracts()")
case forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup FunctionSelector
setUp Map FunctionSelector Method
theAbi of
Maybe Method
Nothing -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return []
Just Method
_ -> do
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams (forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (Text
"targetContracts()", AbiValue
emptyAbi))
Either EvmError (Expr 'Buf)
res <- Stepper (Either EvmError (Expr 'Buf))
Stepper.execFully
case Either EvmError (Expr 'Buf)
res of
Right (ConcreteBuf ByteString
r) ->
let vs :: Vector AbiValue
vs = case AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType (forall (a :: OpticKind). [a] -> Vector a
Vector.fromList [AbiType -> AbiType
AbiArrayDynamicType AbiType
AbiAddressType])) (ByteString -> ByteString
BSLazy.fromStrict ByteString
r) of
AbiTuple Vector AbiValue
v -> Vector AbiValue
v
AbiValue
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"fix me with better types"
targets :: [Addr]
targets = case forall (a :: OpticKind). Vector a -> [a]
Vector.toList Vector AbiValue
vs of
[AbiArrayDynamic AbiType
AbiAddressType Vector AbiValue
ts] ->
let unAbiAddress :: AbiValue -> Addr
unAbiAddress (AbiAddress Addr
a) = Addr
a
unAbiAddress AbiValue
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"fix me with better types"
in AbiValue -> Addr
unAbiAddress forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (a :: OpticKind). Vector a -> [a]
Vector.toList Vector AbiValue
ts
[AbiValue]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"fix me with better types"
in forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure [Addr]
targets
Either EvmError (Expr 'Buf)
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"internal error: unexpected failure code"
exploreRun :: UnitTestOptions -> VM -> ABIMethod -> [ExploreTx] -> IO (Text, Either Text Text, VM)
exploreRun :: UnitTestOptions
-> VM -> Text -> [ExploreTx] -> IO (Text, Either Text Text, VM)
exploreRun 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
initialVm Text
testName [ExploreTx]
replayTxs = do
let oracle :: Fetcher
oracle = SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo
[Addr]
targets <- forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret Fetcher
oracle VM
initialVm (UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions
opts)
let depth :: Int
depth = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
maxDepth
((Bool
x, RLP
counterex), VM
vm') <-
if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null [ExploreTx]
replayTxs then
forall (t :: OpticKind -> OpticKind) (m :: OpticKind -> OpticKind)
(b :: OpticKind) (a :: OpticKind).
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\a :: ((Bool, RLP), VM)
a@((Bool
success, RLP
_),VM
_) Int
_ ->
if Bool
success then
forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret Fetcher
oracle VM
initialVm forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(,) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
testName [] [Addr]
targets Int
depth
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
else forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ((Bool, RLP), VM)
a)
((Bool
True, ([RLP] -> RLP
List [])), VM
initialVm)
[Int
0..Int
fuzzRuns]
else forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret Fetcher
oracle VM
initialVm forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(,) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> UnitTestOptions
-> Text -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP)
initialExplorationStepper UnitTestOptions
opts Text
testName [ExploreTx]
replayTxs [Addr]
targets (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [ExploreTx]
replayTxs)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
if Bool
x
then forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Text
"\x1b[32m[PASS]\x1b[0m " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
" (runs: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (FilePath -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Show a => a -> FilePath
show Int
fuzzRuns) forall (a :: OpticKind). Semigroup a => a -> a -> a
<>Text
", depth: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> FilePath -> Text
pack (forall (a :: OpticKind). Show a => a -> FilePath
show Int
depth) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")",
forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right (VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm' UnitTestOptions
opts Text
testName), VM
vm')
else let replayText :: Text
replayText = if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null [ExploreTx]
replayTxs
then Text
"\nReplay data: '(" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> FilePath -> Text
pack (forall (a :: OpticKind). Show a => a -> FilePath
show Text
testName) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"," forall (a :: OpticKind). Semigroup a => a -> a -> a
<> FilePath -> Text
pack (forall (a :: OpticKind). Show a => a -> FilePath
show (forall (a :: OpticKind). Show a => a -> FilePath
show (ByteString -> ByteStringS
ByteStringS forall (a :: OpticKind) b. (a -> b) -> a -> b
$ RLP -> ByteString
rlpencode RLP
counterex))) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")'"
else Text
" (replayed)"
in forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Text
"\x1b[31m[FAIL]\x1b[0m " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
replayText, forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm' UnitTestOptions
opts Text
testName), VM
vm')
execTest :: UnitTestOptions -> VM -> ABIMethod -> AbiValue -> IO (Bool, VM)
execTest :: UnitTestOptions -> VM -> Text -> AbiValue -> IO (Bool, VM)
execTest 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
vm Text
testName AbiValue
args =
forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret (SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) VM
vm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(,) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> UnitTestOptions -> Text -> AbiValue -> Stepper Bool
execTestStepper UnitTestOptions
opts Text
testName AbiValue
args
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
runOne :: UnitTestOptions -> VM -> ABIMethod -> AbiValue -> IO (Text, Either Text Text, VM)
runOne :: UnitTestOptions
-> VM -> Text -> AbiValue -> IO (Text, Either Text Text, VM)
runOne 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
vm Text
testName AbiValue
args = do
let argInfo :: Text
argInfo = FilePath -> Text
pack (if AbiValue
args forall (a :: OpticKind). Eq a => a -> a -> Bool
== AbiValue
emptyAbi then FilePath
"" else FilePath
" with arguments: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> FilePath
show AbiValue
args)
(Bool
bailed, VM
vm') <- UnitTestOptions -> VM -> Text -> AbiValue -> IO (Bool, VM)
execTest UnitTestOptions
opts VM
vm Text
testName AbiValue
args
(Bool
success, VM
vm'') <- forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret (SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) VM
vm' forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(,) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> (UnitTestOptions -> Text -> Bool -> Stepper Bool
checkFailures UnitTestOptions
opts Text
testName Bool
bailed)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
if Bool
success
then
let gasSpent :: Word64
gasSpent = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num TestVMParams
testParams.gasCall forall (a :: OpticKind). Num a => a -> a -> a
- VM
vm'.state.gas
gasText :: Text
gasText = FilePath -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Show a => a -> FilePath
show (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word64
gasSpent :: Integer)
in
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure
(Text
"\x1b[32m[PASS]\x1b[0m "
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
argInfo forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
" (gas: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
gasText forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")"
, forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right (VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm'' UnitTestOptions
opts Text
testName)
, VM
vm''
)
else if Bool
bailed then
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure
(Text
"\x1b[31m[BAIL]\x1b[0m "
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
argInfo
, forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm'' UnitTestOptions
opts Text
testName)
, VM
vm''
)
else
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure
(Text
"\x1b[31m[FAIL]\x1b[0m "
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
argInfo
, forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm'' UnitTestOptions
opts Text
testName)
, VM
vm''
)
fuzzRun :: UnitTestOptions -> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
fuzzRun :: UnitTestOptions
-> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
fuzzRun 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
vm Text
testName [AbiType]
types = do
let args :: Args
args = Args{ replay :: Maybe (QCGen, Int)
replay = forall (a :: OpticKind). Maybe a
Nothing
, maxSuccess :: Int
maxSuccess = Int
fuzzRuns
, maxDiscardRatio :: Int
maxDiscardRatio = Int
10
, maxSize :: Int
maxSize = Int
100
, chatty :: Bool
chatty = forall (a :: OpticKind). Maybe a -> Bool
isJust Maybe Int
verbose
, maxShrinks :: Int
maxShrinks = forall (a :: OpticKind). Bounded a => a
maxBound
}
forall (prop :: OpticKind).
Testable prop =>
Args -> prop -> IO Result
quickCheckWithResult Args
args (UnitTestOptions -> Text -> [AbiType] -> VM -> Property
fuzzTest UnitTestOptions
opts Text
testName [AbiType]
types VM
vm) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
QC.Success Int
numTests Int
_ Map [FilePath] Int
_ Map FilePath Int
_ Map FilePath (Map FilePath Int)
_ FilePath
_ ->
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Text
"\x1b[32m[PASS]\x1b[0m "
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
" (runs: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (FilePath -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Show a => a -> FilePath
show Int
numTests) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")"
, forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right (VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm UnitTestOptions
opts Text
testName)
, VM
vm
)
QC.Failure Int
_ Int
_ Int
_ Int
_ Int
_ QCGen
_ Int
_ FilePath
_ Maybe AnException
_ FilePath
_ [FilePath]
failCase [FilePath]
_ Set FilePath
_ ->
let abiValue :: AbiValue
abiValue = AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType (forall (a :: OpticKind). [a] -> Vector a
Vector.fromList [AbiType]
types)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSLazy.fromStrict forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> ByteString
hexText (FilePath -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t [a] -> [a]
concat [FilePath]
failCase)
ppOutput :: Text
ppOutput = FilePath -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Show a => a -> FilePath
show AbiValue
abiValue
in do
VM
vm' <- forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret (SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) VM
vm forall (a :: OpticKind) b. (a -> b) -> a -> b
$
UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts Text
testName AbiValue
abiValue forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Text
"\x1b[31m[FAIL]\x1b[0m "
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
". Counterexample: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
ppOutput
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\nRun:\n dapp test --replay '(\"" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\",\""
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (FilePath -> Text
pack (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t [a] -> [a]
concat [FilePath]
failCase)) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\")'\nto test this case again, or \n dapp debug --replay '(\""
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\",\"" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (FilePath -> Text
pack (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t [a] -> [a]
concat [FilePath]
failCase)) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\")'\nto debug it."
, forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm' UnitTestOptions
opts Text
testName)
, VM
vm'
)
Result
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Text
"\x1b[31m[OOPS]\x1b[0m "
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName
, forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm UnitTestOptions
opts Text
testName)
, VM
vm
)
symRun :: UnitTestOptions -> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
symRun :: UnitTestOptions
-> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
symRun 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} VM
vm Text
testName [AbiType]
types = do
let cd :: (Expr 'Buf, [Prop])
cd = Text -> [AbiType] -> [FilePath] -> Expr 'Buf -> (Expr 'Buf, [Prop])
symCalldata Text
testName [AbiType]
types [] (Text -> Expr 'Buf
AbstractBuf Text
"txdata")
shouldFail :: Bool
shouldFail = Text
"proveFail" Text -> Text -> Bool
`isPrefixOf` Text
testName
testContract :: Addr
testContract = VM
vm.state.contract
let failed :: Expr 'Storage -> Prop
failed Expr 'Storage
store = (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
And (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'EWord
readStorage' (Addr -> Expr 'EWord
litAddr Addr
testContract) (W256 -> Expr 'EWord
Lit W256
0) Expr 'Storage
store) (W256 -> Expr 'EWord
Lit W256
2) forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== W256 -> Expr 'EWord
Lit W256
2)
Prop -> Prop -> Prop
.|| (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'EWord
readStorage' (Addr -> Expr 'EWord
litAddr Addr
cheatCode) (W256 -> Expr 'EWord
Lit W256
0x6661696c65640000000000000000000000000000000000000000000000000000) Expr 'Storage
store forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== W256 -> Expr 'EWord
Lit W256
1)
postcondition :: VM -> Expr 'End -> Prop
postcondition = forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
((a, b) -> c) -> a -> b -> c
curry forall (a :: OpticKind) b. (a -> b) -> a -> b
$ case Bool
shouldFail of
Bool
True -> \(VM
_, Expr 'End
post) -> case Expr 'End
post of
Success [Prop]
_ Expr 'Buf
_ Expr 'Storage
store -> Expr 'Storage -> Prop
failed Expr 'Storage
store
Expr 'End
_ -> Bool -> Prop
PBool Bool
True
Bool
False -> \(VM
_, Expr 'End
post) -> case Expr 'End
post of
Success [Prop]
_ Expr 'Buf
_ Expr 'Storage
store -> Prop -> Prop
PNeg (Expr 'Storage -> Prop
failed Expr 'Storage
store)
Failure [Prop]
_ EvmError
_ -> Bool -> Prop
PBool Bool
False
Partial [Prop]
_ PartialExec
_ -> Bool -> Prop
PBool Bool
True
Expr 'End
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"Internal Error: Invalid leaf node"
VM
vm' <- forall (a :: OpticKind). Fetcher -> VM -> Stepper a -> IO a
EVM.Stepper.interpret (SolverGroup -> RpcInfo -> Fetcher
Fetch.oracle SolverGroup
solvers RpcInfo
rpcInfo) VM
vm forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
EVM ()
popTrace
TestVMParams -> (Expr 'Buf, [Prop]) -> EVM ()
makeTxCall TestVMParams
testParams (Expr 'Buf, [Prop])
cd
forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
(Expr 'End
_, [VerifyResult]
results) <- SolverGroup
-> VeriOpts
-> VM
-> Maybe (VM -> Expr 'End -> Prop)
-> IO (Expr 'End, [VerifyResult])
verify SolverGroup
solvers (UnitTestOptions -> VeriOpts
makeVeriOpts UnitTestOptions
opts) VM
vm' (forall (a :: OpticKind). a -> Maybe a
Just VM -> Expr 'End -> Prop
postcondition)
if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
(a -> Bool) -> t a -> Bool
all forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
ProofResult a b c -> Bool
isQed [VerifyResult]
results
then do
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Text
"\x1b[32m[PASS]\x1b[0m " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName, forall (a :: OpticKind) (b :: OpticKind). b -> Either a b
Right Text
"", VM
vm)
else do
let x :: [(Expr 'End, SMTCex)]
x = forall (a :: OpticKind) (b :: OpticKind).
(a -> Maybe b) -> [a] -> [b]
mapMaybe VerifyResult -> Maybe (Expr 'End, SMTCex)
extractCex [VerifyResult]
results
let y :: Text
y = UnitTestOptions
-> Text -> Expr 'Buf -> [AbiType] -> [(Expr 'End, SMTCex)] -> Text
symFailure UnitTestOptions
opts Text
testName (forall (a :: OpticKind) (b :: OpticKind). (a, b) -> a
fst (Expr 'Buf, [Prop])
cd) [AbiType]
types [(Expr 'End, SMTCex)]
x
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Text
"\x1b[31m[FAIL]\x1b[0m " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
testName, forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left Text
y, VM
vm)
symFailure :: UnitTestOptions -> Text -> Expr Buf -> [AbiType] -> [(Expr End, SMTCex)] -> Text
symFailure :: UnitTestOptions
-> Text -> Expr 'Buf -> [AbiType] -> [(Expr 'End, SMTCex)] -> Text
symFailure 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..} Text
testName Expr 'Buf
cd [AbiType]
types [(Expr 'End, SMTCex)]
failures' =
forall (a :: OpticKind). Monoid a => [a] -> a
mconcat
[ Text
"Failure: "
, Text
testName
, Text
"\n\n"
, Text -> [Text] -> Text
intercalate Text
"\n" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Text -> Text
indentLines Int
2 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (Expr 'End, SMTCex) -> Text
mkMsg forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [(Expr 'End, SMTCex)]
failures'
]
where
ctx :: DappContext
ctx = DappContext { $sel:info:DappContext :: DappInfo
info = DappInfo
dapp, $sel:env:DappContext :: Map Addr Contract
env = forall (a :: OpticKind). Monoid a => a
mempty }
showRes :: Expr 'End -> Text
showRes = \case
Success [Prop]
_ Expr 'Buf
_ Expr 'Storage
_ -> if Text
"proveFail" Text -> Text -> Bool
`isPrefixOf` Text
testName
then Text
"Successful execution"
else Text
"Failed: DSTest Assertion Violation"
Expr 'End
res ->
let ?context = DappContext
ctx
in FilePath -> Text
Text.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'End -> FilePath
prettyvmresult Expr 'End
res
mkMsg :: (Expr 'End, SMTCex) -> Text
mkMsg (Expr 'End
leaf, SMTCex
cex) = [Text] -> Text
Text.unlines
[Text
"Counterexample:"
,Text
""
,Text
" result: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Expr 'End -> Text
showRes Expr 'End
leaf
,Text
" calldata: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> let ?context = DappContext
ctx in (?context::DappContext) =>
SMTCex -> Expr 'Buf -> Text -> [AbiType] -> Text
prettyCalldata SMTCex
cex Expr 'Buf
cd Text
testName [AbiType]
types
, case Maybe Int
verbose of
Maybe Int
_ -> Text
""
]
prettyCalldata :: (?context :: DappContext) => SMTCex -> Expr Buf -> Text -> [AbiType] -> Text
prettyCalldata :: (?context::DappContext) =>
SMTCex -> Expr 'Buf -> Text -> [AbiType] -> Text
prettyCalldata SMTCex
cex Expr 'Buf
buf Text
sig [AbiType]
types = forall (a :: OpticKind). [a] -> a
head (Text -> Text -> [Text]
Text.splitOn Text
"(" Text
sig) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (?context::DappContext) => SMTCex -> [AbiType] -> Expr 'Buf -> Text
showCalldata SMTCex
cex [AbiType]
types Expr 'Buf
buf
showCalldata :: (?context :: DappContext) => SMTCex -> [AbiType] -> Expr Buf -> Text
showCalldata :: (?context::DappContext) => SMTCex -> [AbiType] -> Expr 'Buf -> Text
showCalldata SMTCex
cex [AbiType]
tps Expr 'Buf
buf = Text
"(" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap AbiValue -> Text
showVal [AbiValue]
vals) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
")"
where
argdata :: Expr 'Buf
argdata = W256 -> Expr 'Buf -> Expr 'Buf
Expr.drop W256
4 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Expr a
simplify forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: EType). SMTCex -> Expr a -> Expr a
subModel SMTCex
cex Expr 'Buf
buf
vals :: [AbiValue]
vals = case [AbiType] -> Expr 'Buf -> AbiVals
decodeBuf [AbiType]
tps Expr 'Buf
argdata of
CAbi [AbiValue]
v -> [AbiValue]
v
AbiVals
_ -> forall a. HasCallStack => FilePath -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ FilePath
"Internal Error: unable to abi decode function arguments:\n" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> (Text -> FilePath
Text.unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
argdata)
showVal :: AbiValue -> Text
showVal :: AbiValue -> Text
showVal (AbiBytes Int
_ ByteString
bs) = ByteString -> Text
formatBytes ByteString
bs
showVal (AbiAddress Addr
addr) = FilePath -> Text
Text.pack forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> FilePath
show forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr
addr
showVal AbiValue
v = FilePath -> Text
Text.pack forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> FilePath
show forall (a :: OpticKind) b. (a -> b) -> a -> b
$ AbiValue
v
execSymTest :: UnitTestOptions -> ABIMethod -> (Expr Buf, [Prop]) -> Stepper (Expr End)
execSymTest :: UnitTestOptions
-> Text -> (Expr 'Buf, [Prop]) -> Stepper (Expr 'End)
execSymTest 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
.. } Text
method (Expr 'Buf, [Prop])
cd = do
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
TestVMParams -> (Expr 'Buf, [Prop]) -> EVM ()
makeTxCall TestVMParams
testParams (Expr 'Buf, [Prop])
cd
TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
method)
Stepper (Expr 'End)
runExpr
checkSymFailures :: UnitTestOptions -> Stepper VM
checkSymFailures :: UnitTestOptions -> Stepper VM
checkSymFailures 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
.. } = do
forall (a :: OpticKind). EVM a -> Stepper a
Stepper.evm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
EVM ()
popTrace
TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams (forall (a :: OpticKind) (b :: OpticKind). a -> Either a b
Left (Text
"failed()", AbiValue
emptyAbi))
Stepper VM
Stepper.runFully
indentLines :: Int -> Text -> Text
indentLines :: Int -> Text -> Text
indentLines Int
n Text
s =
let p :: Text
p = Int -> Text -> Text
Text.replicate Int
n Text
" "
in [Text] -> Text
Text.unlines (forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (Text
p <>) (Text -> [Text]
Text.lines Text
s))
passOutput :: VM -> UnitTestOptions -> Text -> Text
passOutput :: VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
.. } Text
testName =
let ?context = DappContext { $sel:info:DappContext :: DappInfo
info = DappInfo
dapp, $sel:env:DappContext :: Map Addr Contract
env = VM
vm.env.contracts }
in let v :: Int
v = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
verbose
in if (Int
v forall (a :: OpticKind). Ord a => a -> a -> Bool
> Int
1) then
forall (a :: OpticKind). Monoid a => [a] -> a
mconcat
[ Text
"Success: "
, forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Text
"" (Text -> Text -> Maybe Text
stripSuffix Text
"()" Text
testName)
, Text
"\n"
, if (Int
v forall (a :: OpticKind). Ord a => a -> a -> Bool
> Int
2) then Int -> Text -> Text
indentLines Int
2 (DappInfo -> VM -> Text
showTraceTree DappInfo
dapp VM
vm) else Text
""
, Int -> Text -> Text
indentLines Int
2 ((?context::DappContext) => Map W256 Event -> [Expr 'Log] -> Text
formatTestLogs DappInfo
dapp.eventMap VM
vm.logs)
, Text
"\n"
]
else Text
""
failOutput :: VM -> UnitTestOptions -> Text -> Text
failOutput :: VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm 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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
.. } Text
testName =
let ?context = DappContext { $sel:info:DappContext :: DappInfo
info = DappInfo
dapp, $sel:env:DappContext :: Map Addr Contract
env = VM
vm.env.contracts }
in forall (a :: OpticKind). Monoid a => [a] -> a
mconcat
[ Text
"Failure: "
, forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Text
"" (Text -> Text -> Maybe Text
stripSuffix Text
"()" Text
testName)
, Text
"\n"
, case Maybe Int
verbose of
Just Int
_ -> Int -> Text -> Text
indentLines Int
2 (DappInfo -> VM -> Text
showTraceTree DappInfo
dapp VM
vm)
Maybe Int
_ -> Text
""
, Int -> Text -> Text
indentLines Int
2 ((?context::DappContext) => Map W256 Event -> [Expr 'Log] -> Text
formatTestLogs DappInfo
dapp.eventMap VM
vm.logs)
, Text
"\n"
]
formatTestLogs :: (?context :: DappContext) => Map W256 Event -> [Expr Log] -> Text
formatTestLogs :: (?context::DappContext) => Map W256 Event -> [Expr 'Log] -> Text
formatTestLogs Map W256 Event
events [Expr 'Log]
xs =
case forall (a :: OpticKind). [Maybe a] -> [a]
catMaybes (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList (forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap ((?context::DappContext) =>
Map W256 Event -> Expr 'Log -> Maybe Text
formatTestLog Map W256 Event
events) [Expr 'Log]
xs)) of
[] -> Text
"\n"
[Text]
ys -> Text
"\n" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"\n" [Text]
ys forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"\n\n"
formatTestLog :: (?context :: DappContext) => Map W256 Event -> Expr Log -> Maybe Text
formatTestLog :: (?context::DappContext) =>
Map W256 Event -> Expr 'Log -> Maybe Text
formatTestLog Map W256 Event
_ (LogEntry Expr 'EWord
_ Expr 'Buf
_ []) = forall (a :: OpticKind). Maybe a
Nothing
formatTestLog Map W256 Event
_ (GVar GVar 'Log
_) = forall a. HasCallStack => FilePath -> a
error FilePath
"unexpected global variable"
formatTestLog Map W256 Event
events (LogEntry Expr 'EWord
_ Expr 'Buf
args (Expr 'EWord
topic:[Expr 'EWord]
_)) =
case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
topic forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \W256
t1 -> (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup W256
t1 Map W256 Event
events) of
Maybe Event
Nothing -> forall (a :: OpticKind). Maybe a
Nothing
Just (Event Text
name Anonymity
_ [(Text, AbiType, Indexed)]
types) ->
case (Text
name forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Text] -> Text
parenthesise (AbiType -> Text
abiTypeSolidity forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> ([(Text, AbiType, Indexed)] -> [AbiType]
unindexed [(Text, AbiType, Indexed)]
types))) of
Text
"log(string)" -> forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> Text
unquote forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (?context::DappContext) => AbiType -> Expr 'Buf -> Text
showValue AbiType
AbiStringType Expr 'Buf
args
Text
"log_named_bytes32(string, bytes32)" -> Maybe Text
log_named
Text
"log_named_address(string, address)" -> Maybe Text
log_named
Text
"log_named_int(string, int256)" -> Maybe Text
log_named
Text
"log_named_uint(string, uint256)" -> Maybe Text
log_named
Text
"log_named_bytes(string, bytes)" -> Maybe Text
log_named
Text
"log_named_string(string, string)" -> Maybe Text
log_named
Text
"log_named_decimal_int(string, int256, uint256)" -> Maybe Text
log_named_decimal
Text
"log_named_decimal_uint(string, uint256, uint256)" -> Maybe Text
log_named_decimal
Text
"log_bytes32(bytes32)" -> Maybe Text
log_unnamed
Text
"log_address(address)" -> Maybe Text
log_unnamed
Text
"log_int(int256)" -> Maybe Text
log_unnamed
Text
"log_uint(uint256)" -> Maybe Text
log_unnamed
Text
"log_bytes(bytes)" -> Maybe Text
log_unnamed
Text
"log_string(string)" -> Maybe Text
log_unnamed
Text
"log_named_bytes32(bytes32, bytes32)" -> Maybe Text
log_named
Text
"log_named_address(bytes32, address)" -> Maybe Text
log_named
Text
"log_named_int(bytes32, int256)" -> Maybe Text
log_named
Text
"log_named_uint(bytes32, uint256)" -> Maybe Text
log_named
Text
_ -> forall (a :: OpticKind). Maybe a
Nothing
where
ts :: [AbiType]
ts = [(Text, AbiType, Indexed)] -> [AbiType]
unindexed [(Text, AbiType, Indexed)]
types
unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
Text.dropAround (\Char
c -> Char
c forall (a :: OpticKind). Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall (a :: OpticKind). Eq a => a -> a -> Bool
== Char
'«' Bool -> Bool -> Bool
|| Char
c forall (a :: OpticKind). Eq a => a -> a -> Bool
== Char
'»')
log_unnamed :: Maybe Text
log_unnamed =
forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (?context::DappContext) => AbiType -> Expr 'Buf -> Text
showValue (forall (a :: OpticKind). [a] -> a
head [AbiType]
ts) Expr 'Buf
args
log_named :: Maybe Text
log_named =
let (Text
key, Text
val) = case forall (a :: OpticKind). Int -> [a] -> [a]
take Int
2 ((?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
textValues [AbiType]
ts Expr 'Buf
args) of
[Text
k, Text
v] -> (Text
k, Text
v)
[Text]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"shouldn't happen"
in forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Text -> Text
unquote Text
key forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
": " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
val
showDecimal :: a -> i -> Text
showDecimal a
dec i
val =
FilePath -> Text
pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Show a => a -> FilePath
show forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (i :: OpticKind). Word8 -> i -> DecimalRaw i
Decimal (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num a
dec) i
val
log_named_decimal :: Maybe Text
log_named_decimal =
case Expr 'Buf
args of
(ConcreteBuf ByteString
b) ->
case forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Get a -> ByteString -> a
runGet (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [AbiType]
ts) [AbiType]
ts) (ByteString -> ByteString
BSLazy.fromStrict ByteString
b) of
[AbiValue
key, (AbiUInt Int
256 Word256
val), (AbiUInt Int
256 Word256
dec)] ->
forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Text -> Text
unquote ((?context::DappContext) => AbiValue -> Text
showAbiValue AbiValue
key)) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
": " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall {i :: OpticKind} {a :: OpticKind}.
(Show i, Integral i, Integral a) =>
a -> i -> Text
showDecimal Word256
dec Word256
val
[AbiValue
key, (AbiInt Int
256 Int256
val), (AbiUInt Int
256 Word256
dec)] ->
forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Text -> Text
unquote ((?context::DappContext) => AbiValue -> Text
showAbiValue AbiValue
key)) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
": " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall {i :: OpticKind} {a :: OpticKind}.
(Show i, Integral i, Integral a) =>
a -> i -> Text
showDecimal Word256
dec Int256
val
[AbiValue]
_ -> forall (a :: OpticKind). Maybe a
Nothing
Expr 'Buf
_ -> forall (a :: OpticKind). a -> Maybe a
Just Text
"<symbolic decimal>"
abiCall :: TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall :: TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
params Either (Text, AbiValue) ByteString
args =
let cd :: ByteString
cd = case Either (Text, AbiValue) ByteString
args of
Left (Text
sig, AbiValue
args') -> Text -> AbiValue -> ByteString
abiMethod Text
sig AbiValue
args'
Right ByteString
b -> ByteString
b
in TestVMParams -> (Expr 'Buf, [Prop]) -> EVM ()
makeTxCall TestVMParams
params (ByteString -> Expr 'Buf
ConcreteBuf ByteString
cd, [])
makeTxCall :: TestVMParams -> (Expr Buf, [Prop]) -> EVM ()
makeTxCall :: TestVMParams -> (Expr 'Buf, [Prop]) -> EVM ()
makeTxCall TestVMParams
params (Expr 'Buf
cd, [Prop]
cdProps) = do
EVM ()
resetState
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "isCreate" a => a
#isCreate) Bool
False
Addr -> EVM ()
loadContract TestVMParams
params.address
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "calldata" a => a
#calldata) Expr 'Buf
cd
#constraints %= (<> cdProps)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "caller" a => a
#caller) (Addr -> Expr 'EWord
litAddr TestVMParams
params.caller)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "gas" a => a
#gas) TestVMParams
params.gasCall
Contract
origin' <- forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (ContractCode -> Contract
initialContract (RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
""))) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at TestVMParams
params.origin)
let originBal :: W256
originBal = Contract
origin'.balance
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (W256
originBal forall (a :: OpticKind). Ord a => a -> a -> Bool
< TestVMParams
params.gasprice forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num TestVMParams
params.gasCall)) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall a. HasCallStack => FilePath -> a
error FilePath
"insufficient balance for gas cost"
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
s -> m ()
put forall (a :: OpticKind) b. (a -> b) -> a -> b
$ VM -> VM
initTx VM
vm
initialUnitTestVm :: UnitTestOptions -> SolcContract -> VM
initialUnitTestVm :: UnitTestOptions -> SolcContract -> VM
initialUnitTestVm (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:ffiAllowed:UnitTestOptions :: UnitTestOptions -> Bool
$sel:testParams:UnitTestOptions :: UnitTestOptions -> TestVMParams
$sel:dapp:UnitTestOptions :: UnitTestOptions -> DappInfo
$sel:vmModifier:UnitTestOptions :: UnitTestOptions -> VM -> VM
$sel:replay:UnitTestOptions :: UnitTestOptions -> Maybe (Text, ByteString)
$sel:fuzzRuns:UnitTestOptions :: UnitTestOptions -> Int
$sel:match:UnitTestOptions :: UnitTestOptions -> Text
$sel:covMatch:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:solver:UnitTestOptions :: UnitTestOptions -> Maybe Text
$sel:smtTimeout:UnitTestOptions :: UnitTestOptions -> Maybe Natural
$sel:maxDepth:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:smtDebug:UnitTestOptions :: UnitTestOptions -> Bool
$sel:askSmtIters:UnitTestOptions :: UnitTestOptions -> Integer
$sel:maxIter:UnitTestOptions :: UnitTestOptions -> Maybe Integer
$sel:verbose:UnitTestOptions :: UnitTestOptions -> Maybe Int
$sel:solvers:UnitTestOptions :: UnitTestOptions -> SolverGroup
$sel:rpcInfo:UnitTestOptions :: UnitTestOptions -> RpcInfo
..}) SolcContract
theContract =
let
vm :: VM
vm = VMOpts -> VM
makeVm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ VMOpts
{ $sel:contract:VMOpts :: Contract
contract = ContractCode -> Contract
initialContract (ByteString -> Expr 'Buf -> ContractCode
InitCode SolcContract
theContract.creationCode forall (a :: OpticKind). Monoid a => a
mempty)
, $sel:calldata:VMOpts :: (Expr 'Buf, [Prop])
calldata = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:value:VMOpts :: Expr 'EWord
value = W256 -> Expr 'EWord
Lit W256
0
, $sel:address:VMOpts :: Addr
address = TestVMParams
testParams.address
, $sel:caller:VMOpts :: Expr 'EWord
caller = Addr -> Expr 'EWord
litAddr TestVMParams
testParams.caller
, $sel:origin:VMOpts :: Addr
origin = TestVMParams
testParams.origin
, $sel:gas:VMOpts :: Word64
gas = TestVMParams
testParams.gasCreate
, $sel:gaslimit:VMOpts :: Word64
gaslimit = TestVMParams
testParams.gasCreate
, $sel:coinbase:VMOpts :: Addr
coinbase = TestVMParams
testParams.coinbase
, $sel:number:VMOpts :: W256
number = TestVMParams
testParams.number
, $sel:timestamp:VMOpts :: Expr 'EWord
timestamp = W256 -> Expr 'EWord
Lit TestVMParams
testParams.timestamp
, $sel:blockGaslimit:VMOpts :: Word64
blockGaslimit = TestVMParams
testParams.gaslimit
, $sel:gasprice:VMOpts :: W256
gasprice = TestVMParams
testParams.gasprice
, $sel:baseFee:VMOpts :: W256
baseFee = TestVMParams
testParams.baseFee
, $sel:priorityFee:VMOpts :: W256
priorityFee = TestVMParams
testParams.priorityFee
, $sel:maxCodeSize:VMOpts :: W256
maxCodeSize = TestVMParams
testParams.maxCodeSize
, $sel:prevRandao:VMOpts :: W256
prevRandao = TestVMParams
testParams.prevrandao
, $sel:schedule:VMOpts :: FeeSchedule Word64
schedule = forall (n :: OpticKind). Num n => FeeSchedule n
FeeSchedule.berlin
, $sel:chainId:VMOpts :: W256
chainId = TestVMParams
testParams.chainId
, $sel:create:VMOpts :: Bool
create = Bool
True
, $sel:initialStorage:VMOpts :: Expr 'Storage
initialStorage = Expr 'Storage
EmptyStore
, $sel:txAccessList:VMOpts :: Map Addr [W256]
txAccessList = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:allowFFI:VMOpts :: Bool
allowFFI = Bool
ffiAllowed
}
creator :: IxValue (Map Addr Contract)
creator =
ContractCode -> Contract
initialContract (RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
""))
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce W256
1
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "balance" a => a
#balance TestVMParams
testParams.balanceCreate
in VM
vm
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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 (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
ethrunAddress) (forall (a :: OpticKind). a -> Maybe a
Just IxValue (Map Addr Contract)
creator)
getParametersFromEnvironmentVariables :: Maybe Text -> IO TestVMParams
getParametersFromEnvironmentVariables :: Maybe Text -> IO TestVMParams
getParametersFromEnvironmentVariables Maybe Text
rpc = do
BlockNumber
block' <- forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe BlockNumber
Fetch.Latest (W256 -> BlockNumber
Fetch.BlockNumber forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Read a => FilePath -> a
read) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> (FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"DAPP_TEST_NUMBER")
(Addr
miner,Expr 'EWord
ts,W256
blockNum,W256
ran,Word64
limit,W256
base) <-
case Maybe Text
rpc of
Maybe Text
Nothing -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return (Addr
0,W256 -> Expr 'EWord
Lit W256
0,W256
0,W256
0,Word64
0,W256
0)
Just Text
url -> BlockNumber -> Text -> IO (Maybe Block)
Fetch.fetchBlockFrom BlockNumber
block' Text
url forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Maybe Block
Nothing -> forall a. HasCallStack => FilePath -> a
error FilePath
"Could not fetch block"
Just Block{Word64
FeeSchedule Word64
Addr
W256
Expr 'EWord
$sel:schedule:Block :: Block -> FeeSchedule Word64
$sel:maxCodeSize:Block :: Block -> W256
$sel:baseFee:Block :: Block -> W256
$sel:gaslimit:Block :: Block -> Word64
$sel:prevRandao:Block :: Block -> W256
$sel:number:Block :: Block -> W256
$sel:timestamp:Block :: Block -> Expr 'EWord
$sel:coinbase:Block :: Block -> Addr
schedule :: FeeSchedule Word64
maxCodeSize :: W256
baseFee :: W256
gaslimit :: Word64
prevRandao :: W256
number :: W256
timestamp :: Expr 'EWord
coinbase :: Addr
..} -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return ( Addr
coinbase
, Expr 'EWord
timestamp
, W256
number
, W256
prevRandao
, Word64
gaslimit
, W256
baseFee
)
let
getWord :: FilePath -> b -> IO b
getWord FilePath
s b
def = forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe b
def forall (a :: OpticKind). Read a => FilePath -> a
read forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
s
getAddr :: FilePath -> b -> IO b
getAddr FilePath
s b
def = forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe b
def forall (a :: OpticKind). Read a => FilePath -> a
read forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
s
ts' :: W256
ts' = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"Internal Error: received unexpected symbolic timestamp via rpc") (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
ts)
Addr
-> Addr
-> Addr
-> Word64
-> Word64
-> W256
-> W256
-> W256
-> Addr
-> W256
-> W256
-> Word64
-> W256
-> W256
-> W256
-> W256
-> TestVMParams
TestVMParams
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getAddr FilePath
"DAPP_TEST_ADDRESS" (Addr -> W256 -> Addr
createAddress Addr
ethrunAddress W256
1)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getAddr FilePath
"DAPP_TEST_CALLER" Addr
ethrunAddress
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getAddr FilePath
"DAPP_TEST_ORIGIN" Addr
ethrunAddress
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_GAS_CREATE" Word64
defaultGasForCreating
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_GAS_CALL" Word64
defaultGasForInvoking
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_BASEFEE" W256
base
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_PRIORITYFEE" W256
0
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_BALANCE" W256
defaultBalanceForTestContract
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getAddr FilePath
"DAPP_TEST_COINBASE" Addr
miner
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_NUMBER" W256
blockNum
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_TIMESTAMP" W256
ts'
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_GAS_LIMIT" Word64
limit
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_GAS_PRICE" W256
0
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_MAXCODESIZE" W256
defaultMaxCodeSize
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_PREVRANDAO" W256
ran
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {b :: OpticKind}. Read b => FilePath -> b -> IO b
getWord FilePath
"DAPP_TEST_CHAINID" W256
99