{-# Language LambdaCase #-}
{-# Language DataKinds #-}
{-# Language ImplicitParams #-}

module EVM.UnitTest where

import Prelude hiding (Word)

import EVM
import EVM.ABI
import EVM.Concrete hiding (readMemoryWord)
import EVM.Symbolic
import EVM.Dapp
import EVM.Debug (srcMapCodePos)
import EVM.Exec
import EVM.Format
import EVM.Solidity
import EVM.SymExec
import EVM.Types
import EVM.Transaction (initTx)
import EVM.RLP
import qualified EVM.Fetch

import qualified EVM.FeeSchedule as FeeSchedule

import EVM.Stepper (Stepper, interpret)
import qualified EVM.Stepper as Stepper
import qualified Control.Monad.Operational as Operational

import Control.Lens hiding (Indexed, elements, List)
import Control.Monad.State.Strict hiding (state)
import qualified Control.Monad.State.Strict as State

import Control.Monad.Par.Class (spawn_)
import Control.Monad.Par.IO (runParIO)

import qualified Data.ByteString.Lazy as BSLazy
import qualified Data.SBV.Trans.Control as SBV (Query, getValue, resetAssertions)
import qualified Data.SBV.Internals as SBV (State)
import Data.Binary.Get    (runGet)
import Data.ByteString    (ByteString)
import Data.SBV    hiding (verbose)
import Data.SBV.Control   (CheckSatResult(..), checkSat)
import Data.Decimal       (DecimalRaw(..))
import Data.Either        (isRight, lefts)
import Data.Foldable      (toList)
import Data.Map           (Map)
import Data.Maybe         (fromMaybe, catMaybes, fromJust, isJust, fromMaybe, mapMaybe, isNothing)
import Data.Text          (isPrefixOf, stripSuffix, intercalate, Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import System.Environment (lookupEnv)
import System.IO          (hFlush, stdout)

import qualified Control.Monad.Par.Class as Par
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import Data.MultiSet (MultiSet)
import qualified Data.MultiSet as MultiSet

import Data.Set (Set)
import qualified Data.Set as Set

import Data.Vector (Vector)
import qualified Data.Vector as Vector

import Test.QuickCheck hiding (verbose)

data UnitTestOptions = UnitTestOptions
  { UnitTestOptions -> Query -> IO (EVM ())
oracle     :: EVM.Query -> IO (EVM ())
  , UnitTestOptions -> Maybe Int
verbose    :: Maybe Int
  , UnitTestOptions -> Maybe Integer
maxIter    :: Maybe Integer
  , UnitTestOptions -> Maybe Int
maxDepth   :: Maybe Int
  , UnitTestOptions -> Maybe Integer
smtTimeout :: Maybe Integer
  , UnitTestOptions -> Maybe State
smtState   :: Maybe SBV.State
  , UnitTestOptions -> Maybe Text
solver     :: 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
allowFFI   :: Bool
  }

data TestVMParams = TestVMParams
  { TestVMParams -> Addr
testAddress       :: Addr
  , TestVMParams -> Addr
testCaller        :: Addr
  , TestVMParams -> Addr
testOrigin        :: Addr
  , TestVMParams -> W256
testGasCreate     :: W256
  , TestVMParams -> W256
testGasCall       :: W256
  , TestVMParams -> W256
testBalanceCreate :: W256
  , TestVMParams -> W256
testBalanceCall   :: W256
  , TestVMParams -> Addr
testCoinbase      :: Addr
  , TestVMParams -> W256
testNumber        :: W256
  , TestVMParams -> W256
testTimestamp     :: W256
  , TestVMParams -> W256
testGaslimit      :: W256
  , TestVMParams -> W256
testGasprice      :: W256
  , TestVMParams -> W256
testMaxCodeSize   :: W256
  , TestVMParams -> W256
testDifficulty    :: W256
  , TestVMParams -> W256
testChainId       :: W256
  }

defaultGasForCreating :: W256
defaultGasForCreating :: W256
defaultGasForCreating = W256
0xffffffffffff

defaultGasForInvoking :: W256
defaultGasForInvoking :: W256
defaultGasForInvoking = W256
0xffffffffffff

defaultBalanceForCreator :: W256
defaultBalanceForCreator :: W256
defaultBalanceForCreator = W256
0xffffffffffffffffffffffff

defaultBalanceForCreated :: W256
defaultBalanceForCreated :: W256
defaultBalanceForCreated = W256
0xffffffffffffffffffffffff

defaultMaxCodeSize :: W256
defaultMaxCodeSize :: W256
defaultMaxCodeSize = W256
0xffffffff

type ABIMethod = Text

-- | Assuming a constructor is loaded, this stepper will run the constructor
-- to create the test contract, give it an initial balance, and run `setUp()'.
initializeUnitTest :: UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest :: UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions { Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } SolcContract
theContract = do

  let addr :: Addr
addr = TestVMParams -> Addr
testAddress TestVMParams
testParams

  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
    -- Maybe modify the initial VM, e.g. to load library code
    (VM -> VM) -> EVM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify VM -> VM
vmModifier
    -- Make a trace entry for running the constructor
    TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
"constructor")

  -- Constructor is loaded; run until it returns code
  ProgramT Action Identity (Either Error Buffer) -> Stepper ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ProgramT Action Identity (Either Error Buffer)
Stepper.execFully

  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
    -- Give a balance to the test target
    (Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Env -> Identity Env)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Word -> Identity Word)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Word -> Identity Word)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Identity Word)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
balance ((Word -> Identity Word) -> VM -> Identity VM) -> Word -> EVM ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= W256 -> Word
w256 (TestVMParams -> W256
testBalanceCreate TestVMParams
testParams)

    -- call setUp(), if it exists, to initialize the test contract
    let theAbi :: Map Word32 Method
theAbi = Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap SolcContract
theContract
        setUp :: Word32
setUp  = ByteString -> Word32
abiKeccak (Text -> ByteString
encodeUtf8 Text
"setUp()")

    Bool -> EVM () -> EVM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Method -> Bool
forall a. Maybe a -> Bool
isJust (Word32 -> Map Word32 Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32
setUp Map Word32 Method
theAbi)) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
      TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams ((Text, AbiValue) -> Either (Text, AbiValue) ByteString
forall a b. a -> Either a b
Left (Text
"setUp()", AbiValue
emptyAbi))
      EVM ()
popTrace
      TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
"setUp()")

  -- Let `setUp()' run to completion
  Either Error Buffer
res <- ProgramT Action Identity (Either Error Buffer)
Stepper.execFully
  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ case Either Error Buffer
res of
    Left Error
e -> TraceData -> EVM ()
pushTrace (Error -> TraceData
ErrorTrace Error
e)
    Either Error Buffer
_ -> EVM ()
popTrace


-- | Assuming a test contract is loaded and initialized, this stepper
-- will run the specified test method and return whether it succeeded.
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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } Text
methodName' AbiValue
method = do
  -- Set up the call to the test method
  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
    TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams ((Text, AbiValue) -> Either (Text, AbiValue) ByteString
forall a b. a -> Either a b
Left (Text
methodName', AbiValue
method))
    TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
methodName')
  -- Try running the test method
  ProgramT Action Identity (Either Error Buffer)
Stepper.execFully ProgramT Action Identity (Either Error Buffer)
-> (Either Error Buffer -> Stepper Bool) -> Stepper Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
     -- If we failed, put the error in the trace.
    Left Error
e -> EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (TraceData -> EVM ()
pushTrace (Error -> TraceData
ErrorTrace Error
e) EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EVM ()
popTrace) Stepper () -> Stepper Bool -> Stepper Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Stepper Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    Either Error Buffer
_ -> Bool -> Stepper Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

exploreStep :: UnitTestOptions -> ByteString -> Stepper Bool
exploreStep :: UnitTestOptions -> ByteString -> Stepper Bool
exploreStep UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} ByteString
bs = do
  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
    Map Addr Contract
cs <- Getting (Map Addr Contract) VM (Map Addr Contract)
-> StateT VM Identity (Map Addr Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts)
    TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams (ByteString -> Either (Text, AbiValue) ByteString
forall a b. b -> Either a b
Right ByteString
bs)
    let (Method [(Text, AbiType)]
_ [(Text, AbiType)]
inputs Text
sig Text
_ Mutability
_) = Method -> Maybe Method -> Method
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Method
forall a. HasCallStack => [Char] -> a
error [Char]
"unknown abi call") (Maybe Method -> Method) -> Maybe Method -> Method
forall a b. (a -> b) -> a -> b
$ Word32 -> Map Word32 Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (W256 -> Word32
forall a b. (Integral a, Num b) => a -> b
num (W256 -> Word32) -> W256 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs) (Getting (Map Word32 Method) DappInfo (Map Word32 Method)
-> DappInfo -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) DappInfo (Map Word32 Method)
Lens' DappInfo (Map Word32 Method)
dappAbiMap DappInfo
dapp)
        types :: [AbiType]
types = (Text, AbiType) -> AbiType
forall a b. (a, b) -> b
snd ((Text, AbiType) -> AbiType) -> [(Text, AbiType)] -> [AbiType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, AbiType)]
inputs
    let ?context = DappContext dapp cs
    Contract
this <- Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Contract
forall a. HasCallStack => [Char] -> a
error [Char]
"unknown target") (Maybe Contract -> Contract)
-> StateT VM Identity (Maybe Contract)
-> StateT VM Identity Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting (Maybe Contract) VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (TestVMParams -> Addr
testAddress TestVMParams
testParams)))
    let name :: Text
name = Text -> (SolcContract -> Text) -> Maybe SolcContract -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text
contractNamePart (Text -> Text) -> (SolcContract -> Text) -> SolcContract -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text SolcContract Text -> SolcContract -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text SolcContract Text
Lens' SolcContract Text
contractName) (Maybe SolcContract -> Text) -> Maybe SolcContract -> Text
forall a b. (a -> b) -> a -> b
$ ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
this) DappInfo
dapp
    TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (([Char] -> Text
pack ([Char] -> Text) -> (AbiType -> [Char]) -> AbiType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiType -> [Char]
forall a. Show a => a -> [Char]
show) (AbiType -> Text) -> [AbiType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AbiType]
types) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Buffer -> Text
[AbiType] -> Buffer -> Text
showCall [AbiType]
types (ByteString -> Buffer
ConcreteBuffer ByteString
bs)))
  -- Try running the test method
  ProgramT Action Identity (Either Error Buffer)
Stepper.execFully ProgramT Action Identity (Either Error Buffer)
-> (Either Error Buffer -> Stepper Bool) -> Stepper Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
     -- If we failed, put the error in the trace.
    Left Error
e -> EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (TraceData -> EVM ()
pushTrace (Error -> TraceData
ErrorTrace Error
e) EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EVM ()
popTrace) Stepper () -> Stepper Bool -> Stepper Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Stepper Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    Either Error Buffer
_ -> Bool -> Stepper Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


checkFailures :: UnitTestOptions -> ABIMethod -> Bool -> Stepper Bool
checkFailures :: UnitTestOptions -> Text -> Bool -> Stepper Bool
checkFailures UnitTestOptions { Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } Text
method Bool
bailed = do
   -- Decide whether the test is supposed to fail or succeed
  let shouldFail :: Bool
shouldFail = Text
"testFail" Text -> Text -> Bool
`isPrefixOf` Text
method
  if Bool
bailed then
    Bool -> Stepper Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
shouldFail
  else do
    -- Ask whether any assertions failed
    EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
      EVM ()
popTrace
      TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams (Either (Text, AbiValue) ByteString -> EVM ())
-> Either (Text, AbiValue) ByteString -> EVM ()
forall a b. (a -> b) -> a -> b
$ (Text, AbiValue) -> Either (Text, AbiValue) ByteString
forall a b. a -> Either a b
Left (Text
"failed()", AbiValue
emptyAbi)
    Either Error Buffer
res <- ProgramT Action Identity (Either Error Buffer)
Stepper.execFully
    case Either Error Buffer
res of
      Right (ConcreteBuffer ByteString
r) ->
        let AbiBool Bool
failed = AbiType -> ByteString -> AbiValue
decodeAbiValue AbiType
AbiBoolType (ByteString -> ByteString
BSLazy.fromStrict ByteString
r)
        in Bool -> Stepper Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
shouldFail Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
failed)
      Either Error Buffer
_ -> [Char] -> Stepper Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: unexpected failure code"

-- | Randomly generates the calldata arguments and runs the test
fuzzTest :: UnitTestOptions -> Text -> [AbiType] -> VM -> Property
fuzzTest :: UnitTestOptions -> Text -> [AbiType] -> VM -> Property
fuzzTest UnitTestOptions
opts Text
sig [AbiType]
types VM
vm = Gen AbiValue
-> (AbiValue -> [Char]) -> (AbiValue -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [Char]) -> (a -> prop) -> Property
forAllShow (AbiType -> Gen AbiValue
genAbiValue (Vector AbiType -> AbiType
AbiTupleType (Vector AbiType -> AbiType) -> Vector AbiType -> AbiType
forall a b. (a -> b) -> a -> b
$ [AbiType] -> Vector AbiType
forall a. [a] -> Vector a
Vector.fromList [AbiType]
types)) (ByteStringS -> [Char]
forall a. Show a => a -> [Char]
show (ByteStringS -> [Char])
-> (AbiValue -> ByteStringS) -> AbiValue -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringS
ByteStringS (ByteString -> ByteStringS)
-> (AbiValue -> ByteString) -> AbiValue -> ByteStringS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiValue -> ByteString
encodeAbiValue)
  ((AbiValue -> Property) -> Property)
-> (AbiValue -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \AbiValue
args -> IO Bool -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Bool -> Property) -> IO Bool -> Property
forall a b. (a -> b) -> a -> b
$
    (Bool, VM) -> Bool
forall a b. (a, b) -> a
fst ((Bool, VM) -> Bool) -> IO (Bool, VM) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT VM IO Bool -> VM -> IO (Bool, VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Query -> IO (EVM ())) -> Stepper Bool -> StateT VM IO Bool
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret (UnitTestOptions -> Query -> IO (EVM ())
oracle UnitTestOptions
opts) (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts Text
sig AbiValue
args)) VM
vm

tick :: Text -> IO ()
tick :: Text -> IO ()
tick Text
x = Text -> IO ()
Text.putStr Text
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout

-- | This is like an unresolved source mapping.
data OpLocation = OpLocation
  { OpLocation -> Contract
srcContract :: Contract
  , OpLocation -> Int
srcOpIx :: Int
  } deriving (Int -> OpLocation -> ShowS
[OpLocation] -> ShowS
OpLocation -> [Char]
(Int -> OpLocation -> ShowS)
-> (OpLocation -> [Char])
-> ([OpLocation] -> ShowS)
-> Show OpLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OpLocation] -> ShowS
$cshowList :: [OpLocation] -> ShowS
show :: OpLocation -> [Char]
$cshow :: OpLocation -> [Char]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b' Bool -> Bool -> Bool
&& Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
a ContractCode -> ContractCode -> Bool
forall a. Eq a => a -> a -> Bool
== Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
a'

instance Ord OpLocation where
  compare :: OpLocation -> OpLocation -> Ordering
compare (OpLocation Contract
a Int
b) (OpLocation Contract
a' Int
b') = (ContractCode, Int) -> (ContractCode, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
a, Int
b) (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
a', 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 ->
      [Char] -> OpLocation
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: why no contract?"
    Just Contract
c ->
      Contract -> Int -> OpLocation
OpLocation
        Contract
c
        (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"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
                      Maybe VMResult -> VMResult
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe VMResult -> VMResult)
-> StateT CoverageState IO (Maybe VMResult)
-> StateT CoverageState IO VMResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe VMResult) CoverageState (Maybe VMResult)
-> StateT CoverageState IO (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((VM -> Const (Maybe VMResult) VM)
-> CoverageState -> Const (Maybe VMResult) CoverageState
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((VM -> Const (Maybe VMResult) VM)
 -> CoverageState -> Const (Maybe VMResult) CoverageState)
-> ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
    -> VM -> Const (Maybe VMResult) VM)
-> Getting (Maybe VMResult) CoverageState (Maybe VMResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result)

runWithCoverage :: StateT CoverageState IO VM
runWithCoverage :: StateT CoverageState IO VM
runWithCoverage = do
  -- This is just like `exec` except for every instruction evaluated,
  -- we also increment a counter indexed by the current code location.
  VM
vm0 <- Getting VM CoverageState VM -> StateT CoverageState IO VM
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting VM CoverageState VM
forall s t a b. Field1 s t a b => Lens s t a b
_1
  case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm0 of
    Maybe VMResult
Nothing -> do
      VM
vm1 <- LensLike' (Zoomed (StateT VM IO) VM) CoverageState VM
-> StateT VM IO VM -> StateT CoverageState IO VM
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT VM IO) VM) CoverageState VM
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((VM -> ((), VM)) -> StateT VM IO ()
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (EVM () -> VM -> ((), VM)
forall s a. State s a -> s -> (a, s)
runState EVM ()
exec1) StateT VM IO () -> StateT VM IO VM -> StateT VM IO VM
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT VM IO VM
forall s (m :: * -> *). MonadState s m => m s
get)
      LensLike'
  (Zoomed (StateT (MultiSet OpLocation) IO) ())
  CoverageState
  (MultiSet OpLocation)
-> StateT (MultiSet OpLocation) IO () -> StateT CoverageState IO ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT (MultiSet OpLocation) IO) ())
  CoverageState
  (MultiSet OpLocation)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MultiSet OpLocation -> MultiSet OpLocation)
-> StateT (MultiSet OpLocation) IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (OpLocation -> MultiSet OpLocation -> MultiSet OpLocation
forall a. Ord a => a -> MultiSet a -> MultiSet a
MultiSet.insert (VM -> OpLocation
currentOpLocation VM
vm1)))
      StateT CoverageState IO VM
runWithCoverage
    Just VMResult
_ -> VM -> StateT CoverageState IO VM
forall (f :: * -> *) a. Applicative f => a -> f a
pure VM
vm0


interpretWithCoverage
  :: UnitTestOptions
  -> Stepper a
  -> StateT CoverageState IO a
interpretWithCoverage :: UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts =
  ProgramView Action a -> StateT CoverageState IO a
forall a. ProgramView Action a -> StateT CoverageState IO a
eval (ProgramView Action a -> StateT CoverageState IO a)
-> (Stepper a -> ProgramView Action a)
-> Stepper a
-> StateT CoverageState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stepper a -> ProgramView Action a
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
Operational.view

  where
    eval
      :: Operational.ProgramView Stepper.Action a
      -> StateT CoverageState IO a

    eval :: ProgramView Action a -> StateT CoverageState IO a
eval (Operational.Return a
x) =
      a -> StateT CoverageState IO a
forall (f :: * -> *) a. 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 StateT CoverageState IO VMResult
-> (VMResult -> StateT CoverageState IO a)
-> StateT CoverageState IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnitTestOptions
-> ProgramT Action Identity a -> StateT CoverageState IO a
forall a. UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (ProgramT Action Identity a -> StateT CoverageState IO a)
-> (b -> ProgramT Action Identity a)
-> b
-> StateT CoverageState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
        Action b
Stepper.Run ->
          StateT CoverageState IO VM
runWithCoverage StateT CoverageState IO VM
-> (VM -> StateT CoverageState IO a) -> StateT CoverageState IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnitTestOptions
-> ProgramT Action Identity a -> StateT CoverageState IO a
forall a. UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (ProgramT Action Identity a -> StateT CoverageState IO a)
-> (b -> ProgramT Action Identity a)
-> b
-> StateT CoverageState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
        Stepper.Wait Query
q ->
          do EVM ()
m <- IO (EVM ()) -> StateT CoverageState IO (EVM ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UnitTestOptions -> Query -> IO (EVM ())
oracle UnitTestOptions
opts Query
q)
             LensLike' (Zoomed (StateT VM IO) ()) CoverageState VM
-> StateT VM IO () -> StateT CoverageState IO ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT VM IO) ()) CoverageState VM
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((VM -> ((), VM)) -> StateT VM IO ()
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (EVM () -> VM -> ((), VM)
forall s a. State s a -> s -> (a, s)
runState EVM ()
m)) StateT CoverageState IO ()
-> StateT CoverageState IO a -> StateT CoverageState IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnitTestOptions
-> ProgramT Action Identity a -> StateT CoverageState IO a
forall a. UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (b -> ProgramT Action Identity a
k ())
        Stepper.Ask Choose
_ ->
          [Char] -> StateT CoverageState IO a
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot make choice in this interpreter"
        Stepper.IOAct StateT VM IO b
q ->
          LensLike' (Zoomed (StateT VM IO) b) CoverageState VM
-> StateT VM IO b -> StateT CoverageState IO b
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT VM IO) b) CoverageState VM
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((VM -> IO (b, VM)) -> StateT VM IO b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (StateT VM IO b -> VM -> IO (b, VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT VM IO b
q)) StateT CoverageState IO b
-> (b -> StateT CoverageState IO a) -> StateT CoverageState IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnitTestOptions
-> ProgramT Action Identity a -> StateT CoverageState IO a
forall a. UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (ProgramT Action Identity a -> StateT CoverageState IO a)
-> (b -> ProgramT Action Identity a)
-> b
-> StateT CoverageState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k
        Stepper.EVM EVM b
m ->
          LensLike' (Zoomed (StateT VM IO) b) CoverageState VM
-> StateT VM IO b -> StateT CoverageState IO b
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT VM IO) b) CoverageState VM
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((VM -> (b, VM)) -> StateT VM IO b
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
State.state (EVM b -> VM -> (b, VM)
forall s a. State s a -> s -> (a, s)
runState EVM b
m)) StateT CoverageState IO b
-> (b -> StateT CoverageState IO a) -> StateT CoverageState IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnitTestOptions
-> ProgramT Action Identity a -> StateT CoverageState IO a
forall a. UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts (ProgramT Action Identity a -> StateT CoverageState IO a)
-> (b -> ProgramT Action Identity a)
-> b
-> StateT CoverageState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT Action Identity a
k

coverageReport
  :: DappInfo
  -> MultiSet SrcMap
  -> Map Text (Vector (Int, ByteString))
coverageReport :: DappInfo -> MultiSet SrcMap -> Map Text (Vector (Int, ByteString))
coverageReport DappInfo
dapp MultiSet SrcMap
cov =
  let
    sources :: SourceCache
    sources :: SourceCache
sources = Getting SourceCache DappInfo SourceCache -> DappInfo -> SourceCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceCache DappInfo SourceCache
Lens' DappInfo SourceCache
dappSources DappInfo
dapp

    allPositions :: Set (Text, Int)
    allPositions :: Set (Text, Int)
allPositions =
      ( [(Text, Int)] -> Set (Text, Int)
forall a. Ord a => [a] -> Set a
Set.fromList
      ([(Text, Int)] -> Set (Text, Int))
-> (Seq SrcMap -> [(Text, Int)]) -> Seq SrcMap -> Set (Text, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcMap -> Maybe (Text, Int)) -> [SrcMap] -> [(Text, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos SourceCache
sources)
      ([SrcMap] -> [(Text, Int)])
-> (Seq SrcMap -> [SrcMap]) -> Seq SrcMap -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq SrcMap -> [SrcMap]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
      (Seq SrcMap -> Set (Text, Int)) -> Seq SrcMap -> Set (Text, Int)
forall a b. (a -> b) -> a -> b
$ [Seq SrcMap] -> Seq SrcMap
forall a. Monoid a => [a] -> a
mconcat
        ( Getting (Map Text SolcContract) DappInfo (Map Text SolcContract)
-> DappInfo -> Map Text SolcContract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Text SolcContract) DappInfo (Map Text SolcContract)
Lens' DappInfo (Map Text SolcContract)
dappSolcByName DappInfo
dapp
        Map Text SolcContract
-> (Map Text SolcContract -> [SolcContract]) -> [SolcContract]
forall a b. a -> (a -> b) -> b
& Map Text SolcContract -> [SolcContract]
forall k a. Map k a -> [a]
Map.elems
        [SolcContract] -> ([SolcContract] -> [Seq SrcMap]) -> [Seq SrcMap]
forall a b. a -> (a -> b) -> b
& (SolcContract -> Seq SrcMap) -> [SolcContract] -> [Seq SrcMap]
forall a b. (a -> b) -> [a] -> [b]
map (\SolcContract
x -> Getting (Seq SrcMap) SolcContract (Seq SrcMap)
-> SolcContract -> Seq SrcMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq SrcMap) SolcContract (Seq SrcMap)
Lens' SolcContract (Seq SrcMap)
runtimeSrcmap SolcContract
x Seq SrcMap -> Seq SrcMap -> Seq SrcMap
forall a. Semigroup a => a -> a -> a
<> Getting (Seq SrcMap) SolcContract (Seq SrcMap)
-> SolcContract -> Seq SrcMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq SrcMap) SolcContract (Seq SrcMap)
Lens' SolcContract (Seq SrcMap)
creationSrcmap SolcContract
x)
        )
      )

    srcMapCov :: MultiSet (Text, Int)
    srcMapCov :: MultiSet (Text, Int)
srcMapCov = (SrcMap -> Maybe (Text, Int))
-> MultiSet SrcMap -> MultiSet (Text, Int)
forall b a. Ord b => (a -> Maybe b) -> MultiSet a -> MultiSet b
MultiSet.mapMaybe (SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos SourceCache
sources) MultiSet SrcMap
cov

    linesByName :: Map Text (Vector ByteString)
    linesByName :: Map Text (Vector ByteString)
linesByName =
      [(Text, Vector ByteString)] -> Map Text (Vector ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Vector ByteString)] -> Map Text (Vector ByteString))
-> [(Text, Vector ByteString)] -> Map Text (Vector ByteString)
forall a b. (a -> b) -> a -> b
$ ((Text, ByteString)
 -> Vector ByteString -> (Text, Vector ByteString))
-> [(Text, ByteString)]
-> [Vector ByteString]
-> [(Text, Vector ByteString)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          (\(Text
name, ByteString
_) Vector ByteString
lines' -> (Text
name, Vector ByteString
lines'))
          (Getting [(Text, ByteString)] SourceCache [(Text, ByteString)]
-> SourceCache -> [(Text, ByteString)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Text, ByteString)] SourceCache [(Text, ByteString)]
Lens' SourceCache [(Text, ByteString)]
sourceFiles SourceCache
sources)
          (Getting [Vector ByteString] SourceCache [Vector ByteString]
-> SourceCache -> [Vector ByteString]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Vector ByteString] SourceCache [Vector ByteString]
Lens' SourceCache [Vector ByteString]
sourceLines SourceCache
sources)

    f :: Text -> Vector ByteString -> Vector (Int, ByteString)
    f :: Text -> Vector ByteString -> Vector (Int, ByteString)
f Text
name =
      (Int -> ByteString -> (Int, ByteString))
-> Vector ByteString -> Vector (Int, ByteString)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
Vector.imap
        (\Int
i ByteString
bs ->
           let
             n :: Int
n =
               if (Text, Int) -> Set (Text, Int) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Text
name, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Set (Text, Int)
allPositions
               then (Text, Int) -> MultiSet (Text, Int) -> Int
forall a. Ord a => a -> MultiSet a -> Int
MultiSet.occur (Text
name, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MultiSet (Text, Int)
srcMapCov
               else -Int
1
           in (Int
n, ByteString
bs))
  in
    (Text -> Vector ByteString -> Vector (Int, ByteString))
-> Map Text (Vector ByteString)
-> Map Text (Vector (Int, ByteString))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Text -> Vector ByteString -> Vector (Int, ByteString)
f Map Text (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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..}) Map Text SolcContract
contractMap SourceCache
_ (Text
name, [(Test, [AbiType])]
testNames) = do

  -- Look for the wanted contract by name from the Solidity info
  case Getting (First SolcContract) (Map Text SolcContract) SolcContract
-> Map Text SolcContract -> Maybe SolcContract
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text SolcContract)
name) Map Text SolcContract
contractMap of
    Maybe SolcContract
Nothing ->
      -- Fail if there's no such contract
      [Char] -> IO (MultiSet SrcMap)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (MultiSet SrcMap)) -> [Char] -> IO (MultiSet SrcMap)
forall a b. (a -> b) -> a -> b
$ [Char]
"Contract " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack Text
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"

    Just SolcContract
theContract -> do
      -- Construct the initial VM and begin the contract's constructor
      let vm0 :: VM
vm0 = UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
theContract
      (VM
vm1, MultiSet OpLocation
cov1) <-
        StateT CoverageState IO () -> CoverageState -> IO CoverageState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
          (UnitTestOptions -> Stepper () -> StateT CoverageState IO ()
forall a. UnitTestOptions -> Stepper a -> StateT CoverageState IO a
interpretWithCoverage UnitTestOptions
opts
            (Text -> Stepper ()
Stepper.enter Text
name Stepper () -> Stepper () -> Stepper ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
theContract))
          (VM
vm0, MultiSet OpLocation
forall a. Monoid a => a
mempty)

      -- Define the thread spawner for test cases
      let
        runOne' :: (Test, [AbiType]) -> ParIO (IVar (MultiSet OpLocation))
runOne' (Test
test, [AbiType]
_) = ParIO (MultiSet OpLocation) -> ParIO (IVar (MultiSet OpLocation))
forall (future :: * -> *) (m :: * -> *) a.
ParFuture future m =>
m a -> m (future a)
spawn_ (ParIO (MultiSet OpLocation) -> ParIO (IVar (MultiSet OpLocation)))
-> (IO (MultiSet OpLocation) -> ParIO (MultiSet OpLocation))
-> IO (MultiSet OpLocation)
-> ParIO (IVar (MultiSet OpLocation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (MultiSet OpLocation) -> ParIO (MultiSet OpLocation)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MultiSet OpLocation) -> ParIO (IVar (MultiSet OpLocation)))
-> IO (MultiSet OpLocation) -> ParIO (IVar (MultiSet OpLocation))
forall a b. (a -> b) -> a -> b
$ do
          (Bool
_, (VM
_, MultiSet OpLocation
cov)) <-
            StateT CoverageState IO Bool
-> CoverageState -> IO (Bool, CoverageState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
              (UnitTestOptions -> Stepper Bool -> StateT CoverageState IO Bool
forall a. 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, MultiSet OpLocation
forall a. Monoid a => a
mempty)
          MultiSet OpLocation -> IO (MultiSet OpLocation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiSet OpLocation
cov
      -- Run all the test cases in parallel and gather their coverages
      [MultiSet OpLocation]
covs <-
        ParIO [MultiSet OpLocation] -> IO [MultiSet OpLocation]
forall a. ParIO a -> IO a
runParIO (((Test, [AbiType]) -> ParIO (IVar (MultiSet OpLocation)))
-> [(Test, [AbiType])] -> ParIO [IVar (MultiSet OpLocation)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Test, [AbiType]) -> ParIO (IVar (MultiSet OpLocation))
runOne' [(Test, [AbiType])]
testNames ParIO [IVar (MultiSet OpLocation)]
-> ([IVar (MultiSet OpLocation)] -> ParIO [MultiSet OpLocation])
-> ParIO [MultiSet OpLocation]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IVar (MultiSet OpLocation) -> ParIO (MultiSet OpLocation))
-> [IVar (MultiSet OpLocation)] -> ParIO [MultiSet OpLocation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IVar (MultiSet OpLocation) -> ParIO (MultiSet OpLocation)
forall (future :: * -> *) (m :: * -> *) a.
ParFuture future m =>
future a -> m a
Par.get)

      -- Sum up all the coverage counts
      let cov2 :: MultiSet OpLocation
cov2 = [MultiSet OpLocation] -> MultiSet OpLocation
forall a. Ord a => [MultiSet a] -> MultiSet a
MultiSet.unions (MultiSet OpLocation
cov1 MultiSet OpLocation
-> [MultiSet OpLocation] -> [MultiSet OpLocation]
forall a. a -> [a] -> [a]
: [MultiSet OpLocation]
covs)

      MultiSet SrcMap -> IO (MultiSet SrcMap)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((OpLocation -> Maybe SrcMap)
-> MultiSet OpLocation -> MultiSet SrcMap
forall b a. 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])])
  -> SBV.Query [(Bool, VM)]
runUnitTestContract :: UnitTestOptions
-> Map Text SolcContract
-> (Text, [(Test, [AbiType])])
-> Query [(Bool, VM)]
runUnitTestContract
  opts :: UnitTestOptions
opts@(UnitTestOptions {Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..}) Map Text SolcContract
contractMap (Text
name, [(Test, [AbiType])]
testSigs) = do

  -- Print a header
  IO () -> QueryT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> QueryT IO ()) -> IO () -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Running " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([(Test, [AbiType])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Test, [AbiType])]
testSigs) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" tests for "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack Text
name

  -- Look for the wanted contract by name from the Solidity info
  case Getting (First SolcContract) (Map Text SolcContract) SolcContract
-> Map Text SolcContract -> Maybe SolcContract
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text SolcContract)
name) Map Text SolcContract
contractMap of
    Maybe SolcContract
Nothing ->
      -- Fail if there's no such contract
      [Char] -> Query [(Bool, VM)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> Query [(Bool, VM)]) -> [Char] -> Query [(Bool, VM)]
forall a b. (a -> b) -> a -> b
$ [Char]
"Contract " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack Text
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"

    Just SolcContract
theContract -> do
      -- Construct the initial VM and begin the contract's constructor
      let vm0 :: VM
vm0 = UnitTestOptions -> SolcContract -> VM
initialUnitTestVm UnitTestOptions
opts SolcContract
theContract
      VM
vm1 <-
        IO VM -> QueryT IO VM
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VM -> QueryT IO VM) -> IO VM -> QueryT IO VM
forall a b. (a -> b) -> a -> b
$ StateT VM IO () -> VM -> IO VM
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
          ((Query -> IO (EVM ())) -> Stepper () -> StateT VM IO ()
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle
            (Text -> Stepper ()
Stepper.enter Text
name Stepper () -> Stepper () -> Stepper ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnitTestOptions -> SolcContract -> Stepper ()
initializeUnitTest UnitTestOptions
opts SolcContract
theContract))
          VM
vm0

      case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm1 of
        Maybe VMResult
Nothing -> [Char] -> Query [(Bool, VM)]
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: setUp() did not end with a result"
        Just (VMFailure Error
_) -> IO [(Bool, VM)] -> Query [(Bool, VM)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Bool, VM)] -> Query [(Bool, VM)])
-> IO [(Bool, VM)] -> Query [(Bool, VM)]
forall a 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 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm1 UnitTestOptions
opts Text
"setUp()"
          [(Bool, VM)] -> IO [(Bool, VM)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Bool
False, VM
vm1)]
        Just (VMSuccess Buffer
_) -> do
          let
            runCache :: ([(Either Text Text, VM)], VM) -> (Test, [AbiType])
                        -> SBV.Query ([(Either Text Text, VM)], VM)
            runCache :: ([(Either Text Text, VM)], VM)
-> (Test, [AbiType]) -> Query ([(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]) -> Query (Text, Either Text Text, VM)
runTest UnitTestOptions
opts VM
vm (Test
test, [AbiType]
types)
              IO () -> QueryT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> QueryT IO ()) -> IO () -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
t
              let vmCached :: VM
vmCached = VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM (Map Addr Contract) (Map Addr Contract)
-> Map Addr Contract -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> Cache -> Identity Cache)
-> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched) (Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Cache -> Const (Map Addr Contract) Cache)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Cache
cache ((Cache -> Const (Map Addr Contract) Cache)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Cache -> Const (Map Addr Contract) Cache)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Cache -> Const (Map Addr Contract) Cache
Lens' Cache (Map Addr Contract)
fetched) VM
vm')
              ([(Either Text Text, VM)], VM)
-> Query ([(Either Text Text, VM)], VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Either Text Text
r, VM
vm')(Either Text Text, VM)
-> [(Either Text Text, VM)] -> [(Either Text Text, VM)]
forall a. a -> [a] -> [a]
: [(Either Text Text, VM)]
results), VM
vmCached)

          -- Run all the test cases and print their status updates,
          -- accumulating the vm cache throughout
          ([(Either Text Text, VM)]
details, VM
_) <- (([(Either Text Text, VM)], VM)
 -> (Test, [AbiType]) -> Query ([(Either Text Text, VM)], VM))
-> ([(Either Text Text, VM)], VM)
-> [(Test, [AbiType])]
-> Query ([(Either Text Text, VM)], VM)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([(Either Text Text, VM)], VM)
-> (Test, [AbiType]) -> Query ([(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]

          IO () -> QueryT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> QueryT IO ()) -> IO () -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> IO ()
tick Text
"\n"
            Text -> IO ()
tick ([Text] -> Text
Text.unlines ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
running))
            Text -> IO ()
tick ([Text] -> Text
Text.unlines ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
bailing))

          [(Bool, VM)] -> Query [(Bool, VM)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Either Text Text -> Bool
forall a b. Either a b -> Bool
isRight Either Text Text
r, VM
vm) | (Either Text Text
r, VM
vm) <- [(Either Text Text, VM)]
details]


runTest :: UnitTestOptions -> VM -> (Test, [AbiType]) -> SBV.Query (Text, Either Text Text, VM)
runTest :: UnitTestOptions
-> VM -> (Test, [AbiType]) -> Query (Text, Either Text Text, VM)
runTest opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
vm (ConcreteTest Text
testName, []) = IO (Text, Either Text Text, VM)
-> Query (Text, Either Text Text, VM)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Either Text Text, VM)
 -> Query (Text, Either Text Text, VM))
-> IO (Text, Either Text Text, VM)
-> Query (Text, Either Text Text, VM)
forall a 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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
vm (ConcreteTest Text
testName, [AbiType]
types) = IO (Text, Either Text Text, VM)
-> Query (Text, Either Text Text, VM)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Either Text Text, VM)
 -> Query (Text, Either Text Text, VM))
-> IO (Text, Either Text Text, VM)
-> Query (Text, Either Text Text, VM)
forall a 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 Text -> Text -> Bool
forall a. 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 (AbiValue -> IO (Text, Either Text Text, VM))
-> AbiValue -> IO (Text, Either Text Text, VM)
forall a b. (a -> b) -> a -> b
$
      AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType ([AbiType] -> Vector AbiType
forall a. [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 UnitTestOptions
opts VM
vm (SymbolicTest Text
testName, [AbiType]
types) = UnitTestOptions
-> VM -> Text -> [AbiType] -> Query (Text, Either Text Text, VM)
symRun UnitTestOptions
opts VM
vm Text
testName [AbiType]
types
runTest opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
vm (InvariantTest Text
testName, []) = IO (Text, Either Text Text, VM)
-> Query (Text, Either Text Text, VM)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Either Text Text, VM)
 -> Query (Text, Either Text Text, VM))
-> IO (Text, Either Text Text, VM)
-> Query (Text, Either Text Text, VM)
forall a 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 Text -> Text -> Bool
forall a. 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) = [Char] -> Query (Text, Either Text Text, VM)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Query (Text, Either Text Text, VM))
-> [Char] -> Query (Text, Either Text Text, VM)
forall a b. (a -> b) -> a -> b
$ [Char]
"invariant testing with arguments: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [AbiType] -> [Char]
forall a. Show a => a -> [Char]
show [AbiType]
types [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not implemented (yet!)"

type ExploreTx = (Addr, Addr, ByteString, W256)

decodeCalls :: BSLazy.ByteString -> [ExploreTx]
decodeCalls :: ByteString -> [ExploreTx]
decodeCalls ByteString
b = [ExploreTx] -> Maybe [ExploreTx] -> [ExploreTx]
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> [ExploreTx]
forall a. HasCallStack => [Char] -> a
error [Char]
"could not decode replay data") (Maybe [ExploreTx] -> [ExploreTx])
-> Maybe [ExploreTx] -> [ExploreTx]
forall a b. (a -> b) -> a -> b
$ do
  List [RLP]
v <- ByteString -> Maybe RLP
rlpdecode (ByteString -> Maybe RLP) -> ByteString -> Maybe RLP
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSLazy.toStrict ByteString
b
  [ExploreTx] -> Maybe [ExploreTx]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExploreTx] -> Maybe [ExploreTx])
-> [ExploreTx] -> Maybe [ExploreTx]
forall a b. (a -> b) -> a -> b
$ ((RLP -> ExploreTx) -> [RLP] -> [ExploreTx])
-> [RLP] -> (RLP -> ExploreTx) -> [ExploreTx]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RLP -> ExploreTx) -> [RLP] -> [ExploreTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RLP]
v ((RLP -> ExploreTx) -> [ExploreTx])
-> (RLP -> ExploreTx) -> [ExploreTx]
forall a b. (a -> b) -> a -> b
$ \(List [BS ByteString
caller', BS ByteString
target, BS ByteString
cd, BS ByteString
ts]) -> (W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num (ByteString -> W256
word ByteString
caller'), W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num (ByteString -> W256
word ByteString
target), ByteString
cd, ByteString -> W256
word ByteString
ts)


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  = (Bool, RLP) -> Stepper (Bool, RLP)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, RLP
history)
explorationStepper opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} Text
testName [ExploreTx]
replayData [Addr]
targets (List [RLP]
history) Int
i = do
 (Addr
caller', Addr
target, ByteString
cd, W256
timestamp') <-
   case Getting (First ExploreTx) [ExploreTx] ExploreTx
-> [ExploreTx] -> Maybe ExploreTx
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index [ExploreTx] -> Traversal' [ExploreTx] (IxValue [ExploreTx])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [ExploreTx]
replayData of
     Just ExploreTx
v -> ExploreTx -> ProgramT Action Identity ExploreTx
forall (m :: * -> *) a. Monad m => a -> m a
return ExploreTx
v
     Maybe ExploreTx
Nothing ->
      StateT VM IO ExploreTx -> ProgramT Action Identity ExploreTx
forall a. StateT VM IO a -> Stepper a
Stepper.evmIO (StateT VM IO ExploreTx -> ProgramT Action Identity ExploreTx)
-> StateT VM IO ExploreTx -> ProgramT Action Identity ExploreTx
forall a b. (a -> b) -> a -> b
$ do
       VM
vm <- StateT VM IO VM
forall s (m :: * -> *). MonadState s m => m s
get
       let cs :: Map Addr Contract
cs = Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
vm
           noCode :: Contract -> Bool
noCode Contract
c = case Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
c of
             RuntimeCode Buffer
c' -> Buffer -> Int
len Buffer
c' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
             ContractCode
_ -> Bool
False
           mutable :: Method -> Bool
mutable Method
m = Getting Mutability Method Mutability -> Method -> Mutability
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Mutability Method Mutability
Lens' Method Mutability
methodMutability Method
m Mutability -> [Mutability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Mutability
NonPayable, Mutability
Payable]
           knownAbis :: Map Addr SolcContract
           knownAbis :: Map Addr SolcContract
knownAbis =
             -- exclude contracts without code
             (SolcContract -> Bool)
-> Map Addr SolcContract -> Map Addr SolcContract
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (SolcContract -> Bool) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null (ByteString -> Bool)
-> (SolcContract -> ByteString) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString SolcContract ByteString
-> SolcContract -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString SolcContract ByteString
Lens' SolcContract ByteString
runtimeCode) (Map Addr SolcContract -> Map Addr SolcContract)
-> Map Addr SolcContract -> Map Addr SolcContract
forall a b. (a -> b) -> a -> b
$
             -- exclude contracts without state changing functions
             (SolcContract -> Bool)
-> Map Addr SolcContract -> Map Addr SolcContract
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (SolcContract -> Bool) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Word32 Method -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Word32 Method -> Bool)
-> (SolcContract -> Map Word32 Method) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Method -> Bool) -> Map Word32 Method -> Map Word32 Method
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Method -> Bool
mutable (Map Word32 Method -> Map Word32 Method)
-> (SolcContract -> Map Word32 Method)
-> SolcContract
-> Map Word32 Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap) (Map Addr SolcContract -> Map Addr SolcContract)
-> Map Addr SolcContract -> Map Addr SolcContract
forall a b. (a -> b) -> a -> b
$
             -- exclude testing abis
             (SolcContract -> Bool)
-> Map Addr SolcContract -> Map Addr SolcContract
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Maybe Method -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Method -> Bool)
-> (SolcContract -> Maybe Method) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Method) SolcContract Method
-> SolcContract -> Maybe Method
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map Word32 Method -> Const (First Method) (Map Word32 Method))
-> SolcContract -> Const (First Method) SolcContract
Lens' SolcContract (Map Word32 Method)
abiMap ((Map Word32 Method -> Const (First Method) (Map Word32 Method))
 -> SolcContract -> Const (First Method) SolcContract)
-> ((Method -> Const (First Method) Method)
    -> Map Word32 Method -> Const (First Method) (Map Word32 Method))
-> Getting (First Method) SolcContract Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Word32 Method)
-> Traversal' (Map Word32 Method) (IxValue (Map Word32 Method))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Word32
Index (Map Word32 Method)
unitTestMarkerAbi)) (Map Addr SolcContract -> Map Addr SolcContract)
-> Map Addr SolcContract -> Map Addr SolcContract
forall a b. (a -> b) -> a -> b
$
             -- pick all contracts with known compiler artifacts
             (Maybe SolcContract -> SolcContract)
-> Map Addr (Maybe SolcContract) -> Map Addr SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe SolcContract -> SolcContract
forall a. HasCallStack => Maybe a -> a
fromJust ((Maybe SolcContract -> Bool)
-> Map Addr (Maybe SolcContract) -> Map Addr (Maybe SolcContract)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Maybe SolcContract -> Bool
forall a. Maybe a -> Bool
isJust (Map Addr (Maybe SolcContract) -> Map Addr (Maybe SolcContract))
-> Map Addr (Maybe SolcContract) -> Map Addr (Maybe SolcContract)
forall a b. (a -> b) -> a -> b
$ [(Addr, Maybe SolcContract)] -> Map Addr (Maybe SolcContract)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Addr
addr, ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
c) DappInfo
dapp) | (Addr
addr, Contract
c)  <- Map Addr Contract -> [(Addr, Contract)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Addr Contract
cs])
           selected :: [(Addr, SolcContract)]
selected = [(Addr
addr,
                        SolcContract -> Maybe SolcContract -> SolcContract
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> SolcContract
forall a. HasCallStack => [Char] -> a
error ([Char]
"no src found for: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
addr)) (Maybe SolcContract -> SolcContract)
-> Maybe SolcContract -> SolcContract
forall a b. (a -> b) -> a -> b
$ ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode (Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Contract
forall a. HasCallStack => [Char] -> a
error ([Char] -> Contract) -> [Char] -> Contract
forall a b. (a -> b) -> a -> b
$ [Char]
"contract not found: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
addr) (Maybe Contract -> Contract) -> Maybe Contract -> Contract
forall a b. (a -> b) -> a -> b
$ Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
addr Map Addr Contract
cs)) DappInfo
dapp)
                       | Addr
addr  <- [Addr]
targets]
       -- go to IO and generate a random valid call to any known contract
       IO ExploreTx -> StateT VM IO ExploreTx
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExploreTx -> StateT VM IO ExploreTx)
-> IO ExploreTx -> StateT VM IO ExploreTx
forall a b. (a -> b) -> a -> b
$ do
         -- select random contract
         (Addr
target, SolcContract
solcInfo) <- Gen (Addr, SolcContract) -> IO (Addr, SolcContract)
forall a. Gen a -> IO a
generate (Gen (Addr, SolcContract) -> IO (Addr, SolcContract))
-> Gen (Addr, SolcContract) -> IO (Addr, SolcContract)
forall a b. (a -> b) -> a -> b
$ [(Addr, SolcContract)] -> Gen (Addr, SolcContract)
forall a. [a] -> Gen a
elements (if [Addr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Addr]
targets then Map Addr SolcContract -> [(Addr, SolcContract)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Addr SolcContract
knownAbis else [(Addr, SolcContract)]
selected)
         -- choose a random mutable method
         (Word32
_, (Method [(Text, AbiType)]
_ [(Text, AbiType)]
inputs Text
sig Text
_ Mutability
_)) <- Gen (Word32, Method) -> IO (Word32, Method)
forall a. Gen a -> IO a
generate ([(Word32, Method)] -> Gen (Word32, Method)
forall a. [a] -> Gen a
elements ([(Word32, Method)] -> Gen (Word32, Method))
-> [(Word32, Method)] -> Gen (Word32, Method)
forall a b. (a -> b) -> a -> b
$ Map Word32 Method -> [(Word32, Method)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Word32 Method -> [(Word32, Method)])
-> Map Word32 Method -> [(Word32, Method)]
forall a b. (a -> b) -> a -> b
$ (Method -> Bool) -> Map Word32 Method -> Map Word32 Method
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Method -> Bool
mutable (Map Word32 Method -> Map Word32 Method)
-> Map Word32 Method -> Map Word32 Method
forall a b. (a -> b) -> a -> b
$ Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap SolcContract
solcInfo)
         let types :: [AbiType]
types = (Text, AbiType) -> AbiType
forall a b. (a, b) -> b
snd ((Text, AbiType) -> AbiType) -> [(Text, AbiType)] -> [AbiType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, AbiType)]
inputs
         -- set the caller to a random address with 90% probability, 10% known EOA address
         let knownEOAs :: [Addr]
knownEOAs = Map Addr Contract -> [Addr]
forall k a. Map k a -> [k]
Map.keys (Map Addr Contract -> [Addr]) -> Map Addr Contract -> [Addr]
forall a b. (a -> b) -> a -> b
$ (Contract -> Bool) -> Map Addr Contract -> Map Addr Contract
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Contract -> Bool
noCode Map Addr Contract
cs
         AbiAddress Addr
caller' <-
           if [Addr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Addr]
knownEOAs
           then Gen AbiValue -> IO AbiValue
forall a. Gen a -> IO a
generate (Gen AbiValue -> IO AbiValue) -> Gen AbiValue -> IO AbiValue
forall a b. (a -> b) -> a -> b
$ AbiType -> Gen AbiValue
genAbiValue AbiType
AbiAddressType
           else Gen AbiValue -> IO AbiValue
forall a. Gen a -> IO a
generate (Gen AbiValue -> IO AbiValue) -> Gen AbiValue -> IO AbiValue
forall a b. (a -> b) -> a -> b
$ [(Int, Gen AbiValue)] -> Gen AbiValue
forall a. [(Int, Gen a)] -> Gen a
frequency
             [ (Int
90, AbiType -> Gen AbiValue
genAbiValue AbiType
AbiAddressType)
             , (Int
10, Addr -> AbiValue
AbiAddress (Addr -> AbiValue) -> Gen Addr -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Addr] -> Gen Addr
forall a. [a] -> Gen a
elements [Addr]
knownEOAs)
             ]
         -- make a call with random valid data to the function
         AbiValue
args <- Gen AbiValue -> IO AbiValue
forall a. Gen a -> IO a
generate (Gen AbiValue -> IO AbiValue) -> Gen AbiValue -> IO AbiValue
forall a b. (a -> b) -> a -> b
$ AbiType -> Gen AbiValue
genAbiValue (Vector AbiType -> AbiType
AbiTupleType (Vector AbiType -> AbiType) -> Vector AbiType -> AbiType
forall a b. (a -> b) -> a -> b
$ [AbiType] -> Vector AbiType
forall a. [a] -> Vector a
Vector.fromList [AbiType]
types)
         let cd :: ByteString
cd = Text -> AbiValue -> ByteString
abiMethod (Text
sig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (([Char] -> Text
pack ([Char] -> Text) -> (AbiType -> [Char]) -> AbiType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiType -> [Char]
forall a. Show a => a -> [Char]
show) (AbiType -> Text) -> [AbiType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AbiType]
types) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") AbiValue
args
         -- increment timestamp with random amount
         W256
timepassed <- Word32 -> W256
forall a b. (Integral a, Num b) => a -> b
num (Word32 -> W256) -> IO Word32 -> IO W256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32 -> IO Word32
forall a. Gen a -> IO a
generate (Gen Word32
forall a. Integral a => Gen a
arbitrarySizedNatural :: Gen Word32)
         let ts :: Word
ts = Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word
forall a. HasCallStack => [Char] -> a
error [Char]
"symbolic timestamp not supported here") (Maybe Word -> Word) -> Maybe Word -> Word
forall a b. (a -> b) -> a -> b
$ SymWord -> Maybe Word
maybeLitWord (SymWord -> Maybe Word) -> SymWord -> Maybe Word
forall a b. (a -> b) -> a -> b
$ Getting SymWord VM SymWord -> VM -> SymWord
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Block -> Const SymWord Block) -> VM -> Const SymWord VM
Lens' VM Block
block ((Block -> Const SymWord Block) -> VM -> Const SymWord VM)
-> ((SymWord -> Const SymWord SymWord)
    -> Block -> Const SymWord Block)
-> Getting SymWord VM SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymWord -> Const SymWord SymWord) -> Block -> Const SymWord Block
Lens' Block SymWord
timestamp) VM
vm
         ExploreTx -> IO ExploreTx
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
caller', Addr
target, ByteString
cd, Word -> W256
forall a b. (Integral a, Num b) => a -> b
num Word
ts W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
timepassed)
 let opts' :: UnitTestOptions
opts' = UnitTestOptions
opts { testParams :: TestVMParams
testParams = TestVMParams
testParams {testAddress :: Addr
testAddress = Addr
target, testCaller :: Addr
testCaller = Addr
caller', testTimestamp :: W256
testTimestamp = W256
timestamp'}}
     thisCallRLP :: RLP
thisCallRLP = [RLP] -> RLP
List [ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ Addr -> ByteString
word160Bytes Addr
caller', ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ Addr -> ByteString
word160Bytes Addr
target, ByteString -> RLP
BS ByteString
cd, ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ W256 -> ByteString
word256Bytes W256
timestamp']
 -- set the timestamp
 EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Block -> Identity Block) -> VM -> Identity VM
Lens' VM Block
block ((Block -> Identity Block) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord) -> Block -> Identity Block)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymWord -> Identity SymWord) -> Block -> Identity Block
Lens' Block SymWord
timestamp) (W256 -> SymWord
w256lit W256
timestamp')
 -- perform the call
 Bool
bailed <- UnitTestOptions -> ByteString -> Stepper Bool
exploreStep UnitTestOptions
opts' ByteString
cd
 EVM () -> Stepper ()
forall a. 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
thisCallRLPRLP -> [RLP] -> [RLP]
forall a. a -> [a] -> [a]
:[RLP]
history)
     opts'' :: UnitTestOptions
opts'' = UnitTestOptions
opts {testParams :: TestVMParams
testParams = TestVMParams
testParams {testTimestamp :: W256
testTimestamp = 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
 -- if we didn't revert, run the test function
 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 (Bool, RLP) -> Stepper (Bool, RLP)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, [RLP] -> RLP
List (RLP
thisCallRLPRLP -> [RLP] -> [RLP]
forall a. a -> [a] -> [a]
:[RLP]
history))
explorationStepper UnitTestOptions
_ Text
_ [ExploreTx]
_ [Addr]
_ RLP
_ Int
_  = [Char] -> Stepper (Bool, RLP)
forall a. HasCallStack => [Char] -> a
error [Char]
"malformed rlp"

getTargetContracts :: UnitTestOptions -> Stepper [Addr]
getTargetContracts :: UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} = do
  VM
vm <- EVM VM -> Stepper VM
forall a. EVM a -> Stepper a
Stepper.evm (EVM VM -> Stepper VM) -> EVM VM -> Stepper VM
forall a b. (a -> b) -> a -> b
$ EVM VM
forall s (m :: * -> *). MonadState s m => m s
get
  let Just Contract
contract = VM -> Maybe Contract
currentContract VM
vm
      theAbi :: Map Word32 Method
theAbi = Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap (SolcContract -> Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall a b. (a -> b) -> a -> b
$ Maybe SolcContract -> SolcContract
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SolcContract -> SolcContract)
-> Maybe SolcContract -> SolcContract
forall a b. (a -> b) -> a -> b
$ ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
contract) DappInfo
dapp
      setUp :: Word32
setUp  = ByteString -> Word32
abiKeccak (Text -> ByteString
encodeUtf8 Text
"targetContracts()")
  case Word32 -> Map Word32 Method -> Maybe Method
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32
setUp Map Word32 Method
theAbi of
    Maybe Method
Nothing -> [Addr] -> Stepper [Addr]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Method
_ -> do
      EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams ((Text, AbiValue) -> Either (Text, AbiValue) ByteString
forall a b. a -> Either a b
Left (Text
"targetContracts()", AbiValue
emptyAbi))
      Either Error Buffer
res <- ProgramT Action Identity (Either Error Buffer)
Stepper.execFully
      case Either Error Buffer
res of
        Right (ConcreteBuffer ByteString
r) ->
          let AbiTuple Vector AbiValue
vs = AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType ([AbiType] -> Vector AbiType
forall a. [a] -> Vector a
Vector.fromList [AbiType -> AbiType
AbiArrayDynamicType AbiType
AbiAddressType])) (ByteString -> ByteString
BSLazy.fromStrict ByteString
r)
              [AbiArrayDynamic AbiType
AbiAddressType Vector AbiValue
targets] = Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
vs
          in [Addr] -> Stepper [Addr]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Addr] -> Stepper [Addr]) -> [Addr] -> Stepper [Addr]
forall a b. (a -> b) -> a -> b
$ (AbiValue -> Addr) -> [AbiValue] -> [Addr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AbiAddress Addr
a) -> Addr
a) (Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
targets)
        Either Error Buffer
_ -> [Char] -> Stepper [Addr]
forall a. HasCallStack => [Char] -> a
error [Char]
"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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
initialVm Text
testName [ExploreTx]
replayTxs = do
  ([Addr]
targets, VM
_) <- StateT VM IO [Addr] -> VM -> IO ([Addr], VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Query -> IO (EVM ())) -> Stepper [Addr] -> StateT VM IO [Addr]
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle (UnitTestOptions -> Stepper [Addr]
getTargetContracts UnitTestOptions
opts)) VM
initialVm
  let depth :: Int
depth = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
20 Maybe Int
maxDepth
  ((Bool
x, RLP
counterex), VM
vm') <-
    if [ExploreTx] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExploreTx]
replayTxs
    then
    (((Bool, RLP), VM) -> Int -> IO ((Bool, RLP), VM))
-> ((Bool, RLP), VM) -> [Int] -> IO ((Bool, RLP), VM)
forall (t :: * -> *) (m :: * -> *) b a.
(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 StateT VM IO (Bool, RLP) -> VM -> IO ((Bool, RLP), VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Query -> IO (EVM ()))
-> Stepper (Bool, RLP) -> StateT VM IO (Bool, RLP)
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle (UnitTestOptions
-> Text
-> [ExploreTx]
-> [Addr]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
opts Text
testName [] [Addr]
targets ([RLP] -> RLP
List []) Int
depth)) VM
initialVm
                       else ((Bool, RLP), VM) -> IO ((Bool, RLP), VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool, RLP), VM)
a)
                       ((Bool
True, ([RLP] -> RLP
List [])), VM
initialVm)  -- no canonical "post vm"
                       [Int
0..Int
fuzzRuns]
    else StateT VM IO (Bool, RLP) -> VM -> IO ((Bool, RLP), VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Query -> IO (EVM ()))
-> Stepper (Bool, RLP) -> StateT VM IO (Bool, RLP)
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle (UnitTestOptions
-> Text
-> [ExploreTx]
-> [Addr]
-> RLP
-> Int
-> Stepper (Bool, RLP)
explorationStepper UnitTestOptions
opts Text
testName [ExploreTx]
replayTxs [Addr]
targets ([RLP] -> RLP
List []) ([ExploreTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExploreTx]
replayTxs))) VM
initialVm
  if Bool
x
  then (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"\x1b[32m[PASS]\x1b[0m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
" (runs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fuzzRuns) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
", depth: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
depth) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")",
               Text -> Either Text Text
forall a b. b -> Either a b
Right (VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm' UnitTestOptions
opts Text
testName), VM
vm') -- no canonical "post vm"
  else let replayText :: Text
replayText = if [ExploreTx] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExploreTx]
replayTxs
                        then Text
"\nReplay data: '(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
testName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (ShowS
forall a. Show a => a -> [Char]
show (ByteStringS -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> ByteStringS
ByteStringS (ByteString -> ByteStringS) -> ByteString -> ByteStringS
forall a b. (a -> b) -> a -> b
$ RLP -> ByteString
rlpencode RLP
counterex))) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")'"
                        else Text
" (replayed)"
       in (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"\x1b[31m[FAIL]\x1b[0m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
replayText, Text -> Either Text Text
forall a b. 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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
vm Text
testName AbiValue
args =
  StateT VM IO Bool -> VM -> IO (Bool, VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
    ((Query -> IO (EVM ())) -> Stepper Bool -> StateT VM IO Bool
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
execTestStepper UnitTestOptions
opts Text
testName AbiValue
args))
    VM
vm

-- | Define the thread spawner for normal test cases
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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
vm Text
testName AbiValue
args = do
  let argInfo :: Text
argInfo = [Char] -> Text
pack (if AbiValue
args AbiValue -> AbiValue -> Bool
forall a. Eq a => a -> a -> Bool
== AbiValue
emptyAbi then [Char]
"" else [Char]
" with arguments: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbiValue -> [Char]
forall a. Show a => a -> [Char]
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'') <-
    StateT VM IO Bool -> VM -> IO (Bool, VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
      ((Query -> IO (EVM ())) -> Stepper Bool -> StateT VM IO Bool
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle (UnitTestOptions -> Text -> Bool -> Stepper Bool
checkFailures UnitTestOptions
opts Text
testName Bool
bailed)) VM
vm'
  if Bool
success
  then
     let gasSpent :: Word
gasSpent = W256 -> Word
forall a b. (Integral a, Num b) => a -> b
num (TestVMParams -> W256
testGasCall TestVMParams
testParams) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Getting Word VM Word -> VM -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas) VM
vm'
         gasText :: Text
gasText = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
gasSpent :: Integer)
     in
        (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Text
"\x1b[32m[PASS]\x1b[0m "
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argInfo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (gas: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gasText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          , Text -> Either Text Text
forall a b. b -> Either a b
Right (VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm'' UnitTestOptions
opts Text
testName)
          , VM
vm''
          )
  else if Bool
bailed then
        (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Text
"\x1b[31m[BAIL]\x1b[0m "
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argInfo
          , Text -> Either Text Text
forall a b. a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm'' UnitTestOptions
opts Text
testName)
          , VM
vm''
          )
      else
        (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Text
"\x1b[31m[FAIL]\x1b[0m "
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argInfo
          , Text -> Either Text Text
forall a b. a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm'' UnitTestOptions
opts Text
testName)
          , VM
vm''
          )

-- | Define the thread spawner for property based tests
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
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
vm Text
testName [AbiType]
types = do
  let args :: Args
args = Args :: Maybe (QCGen, Int) -> Int -> Int -> Int -> Bool -> Int -> Args
Args{ replay :: Maybe (QCGen, Int)
replay          = Maybe (QCGen, Int)
forall a. Maybe a
Nothing
                 , maxSuccess :: Int
maxSuccess      = Int
fuzzRuns
                 , maxDiscardRatio :: Int
maxDiscardRatio = Int
10
                 , maxSize :: Int
maxSize         = Int
100
                 , chatty :: Bool
chatty          = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
verbose
                 , maxShrinks :: Int
maxShrinks      = Int
forall a. Bounded a => a
maxBound
                 }
  Args -> Property -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
args (UnitTestOptions -> Text -> [AbiType] -> VM -> Property
fuzzTest UnitTestOptions
opts Text
testName [AbiType]
types VM
vm) IO Result
-> (Result -> IO (Text, Either Text Text, VM))
-> IO (Text, Either Text Text, VM)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Success Int
numTests Int
_ Map [[Char]] Int
_ Map [Char] Int
_ Map [Char] (Map [Char] Int)
_ [Char]
_ ->
      (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"\x1b[32m[PASS]\x1b[0m "
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (runs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numTests) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
             -- this isn't the post vm we actually want, as we
             -- can't retrieve the correct vm from quickcheck
           , Text -> Either Text Text
forall a b. b -> Either a b
Right (VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm UnitTestOptions
opts Text
testName)
           , VM
vm
           )
    Failure Int
_ Int
_ Int
_ Int
_ Int
_ QCGen
_ Int
_ [Char]
_ Maybe AnException
_ [Char]
_ [[Char]]
failCase [[Char]]
_ Set [Char]
_ ->
      let abiValue :: AbiValue
abiValue = AbiType -> ByteString -> AbiValue
decodeAbiValue (Vector AbiType -> AbiType
AbiTupleType ([AbiType] -> Vector AbiType
forall a. [a] -> Vector a
Vector.fromList [AbiType]
types)) (ByteString -> AbiValue) -> ByteString -> AbiValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSLazy.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
hexText ([Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
failCase)
          ppOutput :: Text
ppOutput = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ AbiValue -> [Char]
forall a. Show a => a -> [Char]
show AbiValue
abiValue
      in do
        -- Run the failing test again to get a proper trace
        VM
vm' <- StateT VM IO Bool -> VM -> IO VM
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((Query -> IO (EVM ())) -> Stepper Bool -> StateT VM IO Bool
forall a. (Query -> IO (EVM ())) -> Stepper a -> StateT VM IO a
EVM.Stepper.interpret Query -> IO (EVM ())
oracle (UnitTestOptions -> Text -> AbiValue -> Stepper Bool
runUnitTest UnitTestOptions
opts Text
testName AbiValue
abiValue)) VM
vm
        (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"\x1b[31m[FAIL]\x1b[0m "
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Counterexample: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ppOutput
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nRun:\n dapp test --replay '(\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\",\""
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
failCase)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")'\nto test this case again, or \n dapp debug --replay '(\""
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\",\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
failCase)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")'\nto debug it."
             , Text -> Either Text Text
forall a b. a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm' UnitTestOptions
opts Text
testName)
             , VM
vm'
             )
    Result
_ -> (Text, Either Text Text, VM) -> IO (Text, Either Text Text, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"\x1b[31m[OOPS]\x1b[0m "
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName
              , Text -> Either Text Text
forall a b. a -> Either a b
Left (VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm UnitTestOptions
opts Text
testName)
              , VM
vm
              )

-- | Define the thread spawner for symbolic tests
-- TODO: return a list of VM's
symRun :: UnitTestOptions -> VM -> Text -> [AbiType] -> SBV.Query (Text, Either Text Text, VM)
symRun :: UnitTestOptions
-> VM -> Text -> [AbiType] -> Query (Text, Either Text Text, VM)
symRun opts :: UnitTestOptions
opts@UnitTestOptions{Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} VM
concreteVm Text
testName [AbiType]
types = do
    QueryT IO ()
forall (m :: * -> *). (MonadIO m, MonadQuery m) => m ()
SBV.resetAssertions
    let vm :: VM
vm = VM -> VM
symbolify VM
concreteVm
    ([SWord 8]
cd, W256
cdlen) <- Text -> [AbiType] -> [[Char]] -> Query ([SWord 8], W256)
symCalldata Text
testName [AbiType]
types []
    let cd' :: (Buffer, SymWord)
cd' = ([SWord 8] -> Buffer
SymbolicBuffer [SWord 8]
cd, W256 -> SymWord
w256lit W256
cdlen)
        shouldFail :: Bool
shouldFail = Text
"proveFail" Text -> Text -> Bool
`isPrefixOf` Text
testName

    -- get all posible postVMs for the test method
    [(Bool, VM)]
allPaths <- ([(Bool, VM)], VM) -> [(Bool, VM)]
forall a b. (a, b) -> a
fst (([(Bool, VM)], VM) -> [(Bool, VM)])
-> Query ([(Bool, VM)], VM) -> Query [(Bool, VM)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT VM Query [(Bool, VM)] -> VM -> Query ([(Bool, VM)], VM)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
        ((Query -> IO (EVM ()))
-> Maybe Integer
-> Stepper (Bool, VM)
-> StateT VM Query [(Bool, VM)]
forall a.
(Query -> IO (EVM ()))
-> Maybe Integer -> Stepper a -> StateT VM Query [a]
EVM.SymExec.interpret Query -> IO (EVM ())
oracle Maybe Integer
maxIter (UnitTestOptions -> Text -> (Buffer, SymWord) -> Stepper (Bool, VM)
execSymTest UnitTestOptions
opts Text
testName (Buffer, SymWord)
cd')) VM
vm
    let consistentPaths :: [(Bool, VM)]
consistentPaths = (((Bool, VM) -> Bool) -> [(Bool, VM)] -> [(Bool, VM)])
-> [(Bool, VM)] -> ((Bool, VM) -> Bool) -> [(Bool, VM)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Bool, VM) -> Bool) -> [(Bool, VM)] -> [(Bool, VM)]
forall a. (a -> Bool) -> [a] -> [a]
filter [(Bool, VM)]
allPaths (((Bool, VM) -> Bool) -> [(Bool, VM)])
-> ((Bool, VM) -> Bool) -> [(Bool, VM)]
forall a b. (a -> b) -> a -> b
$
          \(Bool
_, VM
vm') -> case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm' of
            Just (VMFailure Error
DeadPath) -> Bool
False
            Maybe VMResult
_ -> Bool
True
    [Either (VM, Text) ()]
results <- [(Bool, VM)]
-> ((Bool, VM) -> QueryT IO (Either (VM, Text) ()))
-> QueryT IO [Either (VM, Text) ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Bool, VM)]
consistentPaths (((Bool, VM) -> QueryT IO (Either (VM, Text) ()))
 -> QueryT IO [Either (VM, Text) ()])
-> ((Bool, VM) -> QueryT IO (Either (VM, Text) ()))
-> QueryT IO [Either (VM, Text) ()]
forall a b. (a -> b) -> a -> b
$
      -- If the vm execution succeeded, check if the vm is reachable,
      -- and if any ds-test assertions were triggered
      -- Report a failure depending on the prefix of the test name

      -- If the vm execution failed, check if the vm is reachable, and if so,
      -- report a failure unless the test is supposed to fail.

      \(Bool
bailed, VM
vm') -> do
        let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts }
        QueryT IO ()
forall (m :: * -> *). (MonadIO m, MonadQuery m) => m ()
SBV.resetAssertions
        SBool -> QueryT IO ()
forall (m :: * -> *). SolverContext m => SBool -> m ()
constrain (SBool -> QueryT IO ()) -> SBool -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$ [SBool] -> SBool
sAnd ((SBool, Whiff) -> SBool
forall a b. (a, b) -> a
fst ((SBool, Whiff) -> SBool) -> [(SBool, Whiff)] -> [SBool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
-> VM -> [(SBool, Whiff)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
Lens' VM [(SBool, Whiff)]
EVM.constraints VM
vm')
        Bool -> QueryT IO () -> QueryT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
bailed (QueryT IO () -> QueryT IO ()) -> QueryT IO () -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$
          case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm' of
            Just (VMSuccess (SymbolicBuffer [SWord 8]
buf)) ->
              SBool -> QueryT IO ()
forall (m :: * -> *). SolverContext m => SBool -> m ()
constrain (SBool -> QueryT IO ()) -> SBool -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [SWord 8]
litBytes (AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString) -> AbiValue -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> AbiValue
AbiBool (Bool -> AbiValue) -> Bool -> AbiValue
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
shouldFail) [SWord 8] -> [SWord 8] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [SWord 8]
buf
            Maybe VMResult
r -> [Char] -> QueryT IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> QueryT IO ()) -> [Char] -> QueryT IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected return value: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe VMResult -> [Char]
forall a. Show a => a -> [Char]
show Maybe VMResult
r
        Query CheckSatResult
checkSat Query CheckSatResult
-> (CheckSatResult -> QueryT IO (Either (VM, Text) ()))
-> QueryT IO (Either (VM, Text) ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          CheckSatResult
Sat -> do
            Text
prettyCd <- (?context::DappContext) =>
(Buffer, SymWord) -> Text -> [AbiType] -> Query Text
(Buffer, SymWord) -> Text -> [AbiType] -> Query Text
prettyCalldata (Buffer, SymWord)
cd' Text
testName [AbiType]
types
            let explorationFailed :: Bool
explorationFailed = case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm' of
                  Just (VMFailure Error
e) -> case Error
e of
                                          NotUnique Whiff
_ -> Bool
True
                                          Error
UnexpectedSymbolicArg -> Bool
True
                                          Error
_ -> Bool
False
                  Maybe VMResult
_ -> Bool
False
            Either (VM, Text) () -> QueryT IO (Either (VM, Text) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (VM, Text) () -> QueryT IO (Either (VM, Text) ()))
-> Either (VM, Text) () -> QueryT IO (Either (VM, Text) ())
forall a b. (a -> b) -> a -> b
$
              if Bool
shouldFail Bool -> Bool -> Bool
&& Bool
bailed Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
explorationFailed
              then () -> Either (VM, Text) ()
forall a b. b -> Either a b
Right ()
              else (VM, Text) -> Either (VM, Text) ()
forall a b. a -> Either a b
Left (VM
vm', Text
prettyCd)
          CheckSatResult
Unsat -> Either (VM, Text) () -> QueryT IO (Either (VM, Text) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (VM, Text) () -> QueryT IO (Either (VM, Text) ()))
-> Either (VM, Text) () -> QueryT IO (Either (VM, Text) ())
forall a b. (a -> b) -> a -> b
$ () -> Either (VM, Text) ()
forall a b. b -> Either a b
Right ()
          CheckSatResult
Unk -> Either (VM, Text) () -> QueryT IO (Either (VM, Text) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (VM, Text) () -> QueryT IO (Either (VM, Text) ()))
-> Either (VM, Text) () -> QueryT IO (Either (VM, Text) ())
forall a b. (a -> b) -> a -> b
$ (VM, Text) -> Either (VM, Text) ()
forall a b. a -> Either a b
Left (VM
vm', Text
"unknown; query timeout")
          DSat Maybe [Char]
_ -> [Char] -> QueryT IO (Either (VM, Text) ())
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected DSat"

    if [(VM, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(VM, Text)] -> Bool) -> [(VM, Text)] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either (VM, Text) ()] -> [(VM, Text)]
forall a b. [Either a b] -> [a]
lefts [Either (VM, Text) ()]
results
    then
      (Text, Either Text Text, VM) -> Query (Text, Either Text Text, VM)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"\x1b[32m[PASS]\x1b[0m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName, Text -> Either Text Text
forall a b. b -> Either a b
Right Text
"", VM
vm)
    else
      (Text, Either Text Text, VM) -> Query (Text, Either Text Text, VM)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"\x1b[31m[FAIL]\x1b[0m " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testName, Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ UnitTestOptions -> Text -> [(VM, Text)] -> Text
symFailure UnitTestOptions
opts Text
testName ([Either (VM, Text) ()] -> [(VM, Text)]
forall a b. [Either a b] -> [a]
lefts [Either (VM, Text) ()]
results), VM
vm)

symFailure :: UnitTestOptions -> Text -> [(VM, Text)] -> Text
symFailure :: UnitTestOptions -> Text -> [(VM, Text)] -> Text
symFailure UnitTestOptions {Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..} Text
testName [(VM, Text)]
failures' = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
  [ Text
"Failure: "
  , Text
testName
  , Text
"\n\n"
  , Text -> [Text] -> Text
intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
indentLines Int
2 (Text -> Text) -> ((VM, Text) -> Text) -> (VM, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VM, Text) -> Text
mkMsg ((VM, Text) -> Text) -> [(VM, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(VM, Text)]
failures'
  ]
  where
    showRes :: VM -> [Char]
showRes VM
vm = let Just VMResult
res = ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm in
                 case VMResult
res of
                   VMFailure Error
_ ->
                     let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts}
                     in (?context::DappContext) => VMResult -> [Char]
VMResult -> [Char]
prettyvmresult VMResult
res
                   VMSuccess Buffer
_ -> if Text
"proveFail" Text -> Text -> Bool
`isPrefixOf` Text
testName
                                  then [Char]
"Successful execution"
                                  else [Char]
"Failed: DSTest Assertion Violation"
    mkMsg :: (VM, Text) -> Text
mkMsg (VM
vm, Text
cd) = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
      [[Char]
"Counterexample:"
      ,[Char]
""
      ,[Char]
"  result:   " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> VM -> [Char]
showRes VM
vm
      ,[Char]
"  calldata: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
cd
      , case Maybe Int
verbose of
          Just Int
_ -> [[Char]] -> [Char]
unlines
            [ [Char]
""
            , Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
indentLines Int
2 (DappInfo -> VM -> Text
showTraceTree DappInfo
dapp VM
vm)
            ]
          Maybe Int
_ -> [Char]
""
      ]

prettyCalldata :: (?context :: DappContext) => (Buffer, SymWord) -> Text -> [AbiType]-> SBV.Query Text
prettyCalldata :: (Buffer, SymWord) -> Text -> [AbiType] -> Query Text
prettyCalldata (Buffer
buffer, S Whiff
_ SWord 256
cdlen) Text
sig [AbiType]
types = do
  Int
cdlen' <- WordN 256 -> Int
forall a b. (Integral a, Num b) => a -> b
num (WordN 256 -> Int) -> QueryT IO (WordN 256) -> QueryT IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SWord 256 -> QueryT IO (WordN 256)
forall (m :: * -> *) a.
(MonadIO m, MonadQuery m, SymVal a) =>
SBV a -> m a
SBV.getValue SWord 256
cdlen
  ByteString
cd <- case Buffer
buffer of
    SymbolicBuffer [SWord 8]
cd -> (SWord 8 -> QueryT IO Word8) -> [SWord 8] -> QueryT IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SBV Word8 -> QueryT IO Word8
forall (m :: * -> *) a.
(MonadIO m, MonadQuery m, SymVal a) =>
SBV a -> m a
SBV.getValue (SBV Word8 -> QueryT IO Word8)
-> (SWord 8 -> SBV Word8) -> SWord 8 -> QueryT IO Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord 8 -> SBV Word8
forall a. FromSizedBV a => a -> FromSized a
fromSized) (Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
take Int
cdlen' [SWord 8]
cd) QueryT IO [Word8]
-> ([Word8] -> ByteString) -> QueryT IO ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Word8] -> ByteString
BS.pack
    ConcreteBuffer ByteString
cd -> ByteString -> QueryT IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> QueryT IO ByteString)
-> ByteString -> QueryT IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
cdlen' ByteString
cd
  Text -> Query Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Query Text) -> Text -> Query Text
forall a b. (a -> b) -> a -> b
$ ([Text] -> Text
forall a. [a] -> a
head (Text -> Text -> [Text]
Text.splitOn Text
"(" Text
sig)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Buffer -> Text
[AbiType] -> Buffer -> Text
showCall [AbiType]
types (ByteString -> Buffer
ConcreteBuffer ByteString
cd)

execSymTest :: UnitTestOptions -> ABIMethod -> (Buffer, SymWord) -> Stepper (Bool, VM)
execSymTest :: UnitTestOptions -> Text -> (Buffer, SymWord) -> Stepper (Bool, VM)
execSymTest opts :: UnitTestOptions
opts@UnitTestOptions{ Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } Text
method (Buffer, SymWord)
cd = do
  -- Set up the call to the test method
  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
    TestVMParams -> (Buffer, SymWord) -> EVM ()
makeTxCall TestVMParams
testParams (Buffer, SymWord)
cd
    TraceData -> EVM ()
pushTrace (Text -> TraceData
EntryTrace Text
method)
  -- Try running the test method
  Stepper VM
Stepper.runFully Stepper VM -> (VM -> Stepper (Bool, VM)) -> Stepper (Bool, VM)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \VM
vm' -> case ((Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
 -> VM -> Const (Maybe VMResult) VM)
-> VM -> Maybe VMResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe VMResult -> Const (Maybe VMResult) (Maybe VMResult))
-> VM -> Const (Maybe VMResult) VM
Lens' VM (Maybe VMResult)
result VM
vm' of
    Just (VMFailure Error
err) ->
      -- If we failed, put the error in the trace.
      EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (TraceData -> EVM ()
pushTrace (Error -> TraceData
ErrorTrace Error
err)) Stepper () -> Stepper (Bool, VM) -> Stepper (Bool, VM)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Bool, VM) -> Stepper (Bool, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, VM
vm'))
    Just (VMSuccess Buffer
_) -> do
      VM
postVm <- UnitTestOptions -> Stepper VM
checkSymFailures UnitTestOptions
opts
      (Bool, VM) -> Stepper (Bool, VM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, VM
postVm)
    Maybe VMResult
Nothing -> [Char] -> Stepper (Bool, VM)
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal Error: execSymTest: vm has not completed execution!"

checkSymFailures :: UnitTestOptions -> Stepper VM
checkSymFailures :: UnitTestOptions -> Stepper VM
checkSymFailures UnitTestOptions { Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } = do
  -- Ask whether any assertions failed
  EVM () -> Stepper ()
forall a. EVM a -> Stepper a
Stepper.evm (EVM () -> Stepper ()) -> EVM () -> Stepper ()
forall a b. (a -> b) -> a -> b
$ do
    EVM ()
popTrace
    TestVMParams -> Either (Text, AbiValue) ByteString -> EVM ()
abiCall TestVMParams
testParams ((Text, AbiValue) -> Either (Text, AbiValue) ByteString
forall a b. 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 ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> [Text]
Text.lines Text
s))

passOutput :: VM -> UnitTestOptions -> Text -> Text
passOutput :: VM -> UnitTestOptions -> Text -> Text
passOutput VM
vm UnitTestOptions { Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } Text
testName =
  let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts }
  in let v :: Int
v = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
verbose
  in if (Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) then
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Success: "
      , Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> Text -> Maybe Text
stripSuffix Text
"()" Text
testName)
      , Text
"\n"
      , if (Int
v Int -> Int -> Bool
forall a. 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 -> Seq Log -> Text
Map W256 Event -> Seq Log -> Text
formatTestLogs (Getting (Map W256 Event) DappInfo (Map W256 Event)
-> DappInfo -> Map W256 Event
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map W256 Event) DappInfo (Map W256 Event)
Lens' DappInfo (Map W256 Event)
dappEventMap DappInfo
dapp) (Getting (Seq Log) VM (Seq Log) -> VM -> Seq Log
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq Log) VM (Seq Log)
Lens' VM (Seq Log)
logs VM
vm))
      , Text
"\n"
      ]
    else Text
""

failOutput :: VM -> UnitTestOptions -> Text -> Text
failOutput :: VM -> UnitTestOptions -> Text -> Text
failOutput VM
vm UnitTestOptions { Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
.. } Text
testName =
  let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts}
  in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
  [ Text
"Failure: "
  , Text -> Maybe Text -> Text
forall a. 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 -> Seq Log -> Text
Map W256 Event -> Seq Log -> Text
formatTestLogs (Getting (Map W256 Event) DappInfo (Map W256 Event)
-> DappInfo -> Map W256 Event
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map W256 Event) DappInfo (Map W256 Event)
Lens' DappInfo (Map W256 Event)
dappEventMap DappInfo
dapp) (Getting (Seq Log) VM (Seq Log) -> VM -> Seq Log
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq Log) VM (Seq Log)
Lens' VM (Seq Log)
logs VM
vm))
  , Text
"\n"
  ]

formatTestLogs :: (?context :: DappContext) => Map W256 Event -> Seq.Seq Log -> Text
formatTestLogs :: Map W256 Event -> Seq Log -> Text
formatTestLogs Map W256 Event
events Seq Log
xs =
  case [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes (Seq (Maybe Text) -> [Maybe Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((Log -> Maybe Text) -> Seq Log -> Seq (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((?context::DappContext) => Map W256 Event -> Log -> Maybe Text
Map W256 Event -> Log -> Maybe Text
formatTestLog Map W256 Event
events) Seq Log
xs)) of
    [] -> Text
"\n"
    [Text]
ys -> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"\n" [Text]
ys Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"

-- Here we catch and render some special logs emitted by ds-test,
-- with the intent to then present them in a separate view to the
-- regular trace output.
formatTestLog :: (?context :: DappContext) => Map W256 Event -> Log -> Maybe Text
formatTestLog :: Map W256 Event -> Log -> Maybe Text
formatTestLog Map W256 Event
_ (Log Addr
_ Buffer
_ []) = Maybe Text
forall a. Maybe a
Nothing
formatTestLog Map W256 Event
events (Log Addr
_ Buffer
args (SymWord
topic:[SymWord]
_)) =
  case SymWord -> Maybe Word
maybeLitWord SymWord
topic Maybe Word -> (Word -> Maybe Event) -> Maybe Event
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word
t1 -> (W256 -> Map W256 Event -> Maybe Event
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Word -> W256
wordValue Word
t1) Map W256 Event
events) of
    Maybe Event
Nothing -> Maybe Text
forall a. Maybe a
Nothing
    Just (Event Text
name Anonymity
_ [(AbiType, Indexed)]
types) ->
      case (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
parenthesise (AbiType -> Text
abiTypeSolidity (AbiType -> Text) -> [AbiType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(AbiType, Indexed)] -> [AbiType]
unindexed [(AbiType, Indexed)]
types))) of
        Text
"log(string)" -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unquote (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => AbiType -> Buffer -> Text
AbiType -> Buffer -> Text
showValue AbiType
AbiStringType Buffer
args

        -- log_named_x(string, x)
        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

        -- log_named_decimal_x(string, uint, x)
        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

        -- log_x(x)
        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

        -- log_named_x(bytes32, x), as used in older versions of ds-test.
        -- bytes32 are opportunistically represented as strings in Format.hs
        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
_ -> Maybe Text
forall a. Maybe a
Nothing

        where
          ts :: [AbiType]
ts = [(AbiType, Indexed)] -> [AbiType]
unindexed [(AbiType, Indexed)]
types
          unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
Text.dropAround (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'«' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'»')
          log_unnamed :: Maybe Text
log_unnamed =
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => AbiType -> Buffer -> Text
AbiType -> Buffer -> Text
showValue ([AbiType] -> AbiType
forall a. [a] -> a
head [AbiType]
ts) Buffer
args
          log_named :: Maybe Text
log_named =
            let [Text
key, Text
val] = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
2 ((?context::DappContext) => [AbiType] -> Buffer -> [Text]
[AbiType] -> Buffer -> [Text]
textValues [AbiType]
ts Buffer
args)
            in Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unquote Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val
          showDecimal :: a -> i -> Text
showDecimal a
dec i
val =
            [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ DecimalRaw i -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw i -> [Char]) -> DecimalRaw i -> [Char]
forall a b. (a -> b) -> a -> b
$ Word8 -> i -> DecimalRaw i
forall i. Word8 -> i -> DecimalRaw i
Decimal (a -> Word8
forall a b. (Integral a, Num b) => a -> b
num a
dec) i
val
          log_named_decimal :: Maybe Text
log_named_decimal =
            case Buffer
args of
              (ConcreteBuffer ByteString
b) ->
                case Vector AbiValue -> [AbiValue]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector AbiValue -> [AbiValue]) -> Vector AbiValue -> [AbiValue]
forall a b. (a -> b) -> a -> b
$ Get (Vector AbiValue) -> ByteString -> Vector AbiValue
forall a. Get a -> ByteString -> a
runGet (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq ([AbiType] -> Int
forall (t :: * -> *) a. 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)] ->
                    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text
unquote ((?context::DappContext) => AbiValue -> Text
AbiValue -> Text
showAbiValue AbiValue
key)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word256 -> Word256 -> Text
forall i a. (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)] ->
                    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text
unquote ((?context::DappContext) => AbiValue -> Text
AbiValue -> Text
showAbiValue AbiValue
key)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word256 -> Int256 -> Text
forall i a. (Show i, Integral i, Integral a) => a -> i -> Text
showDecimal Word256
dec Int256
val
                  [AbiValue]
_ -> Maybe Text
forall a. Maybe a
Nothing
              (SymbolicBuffer [SWord 8]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"<symbolic decimal>"


word32Bytes :: Word32 -> ByteString
word32Bytes :: Word32 -> ByteString
word32Bytes Word32
x = [Word8] -> ByteString
BS.pack [Word32 -> Int -> Word8
forall a b. (Bits a, Bits b, Integral a, Num b) => a -> Int -> b
byteAt Word32
x (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) | Int
i <- [Int
0..Int
3]]

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
      l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Int -> Word) -> (ByteString -> Int) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ ByteString
cd
  in TestVMParams -> (Buffer, SymWord) -> EVM ()
makeTxCall TestVMParams
params (ByteString -> Buffer
ConcreteBuffer ByteString
cd, Word -> SymWord
litWord Word
l)

makeTxCall :: TestVMParams -> (Buffer, SymWord) -> EVM ()
makeTxCall :: TestVMParams -> (Buffer, SymWord) -> EVM ()
makeTxCall TestVMParams{Addr
W256
testChainId :: W256
testDifficulty :: W256
testMaxCodeSize :: W256
testGasprice :: W256
testGaslimit :: W256
testTimestamp :: W256
testNumber :: W256
testCoinbase :: Addr
testBalanceCall :: W256
testBalanceCreate :: W256
testGasCall :: W256
testGasCreate :: W256
testOrigin :: Addr
testCaller :: Addr
testAddress :: Addr
testChainId :: TestVMParams -> W256
testDifficulty :: TestVMParams -> W256
testMaxCodeSize :: TestVMParams -> W256
testGasprice :: TestVMParams -> W256
testGaslimit :: TestVMParams -> W256
testTimestamp :: TestVMParams -> W256
testNumber :: TestVMParams -> W256
testCoinbase :: TestVMParams -> Addr
testBalanceCall :: TestVMParams -> W256
testBalanceCreate :: TestVMParams -> W256
testGasCall :: TestVMParams -> W256
testGasCreate :: TestVMParams -> W256
testOrigin :: TestVMParams -> Addr
testCaller :: TestVMParams -> Addr
testAddress :: TestVMParams -> Addr
..} (Buffer, SymWord)
cd = do
  EVM ()
resetState
  ASetter VM VM Bool Bool -> Bool -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((TxState -> Identity TxState) -> VM -> Identity VM
Lens' VM TxState
tx ((TxState -> Identity TxState) -> VM -> Identity VM)
-> ((Bool -> Identity Bool) -> TxState -> Identity TxState)
-> ASetter VM VM Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> TxState -> Identity TxState
Lens' TxState Bool
isCreate) Bool
False
  Addr -> EVM ()
loadContract Addr
testAddress
  ASetter VM VM (Buffer, SymWord) (Buffer, SymWord)
-> (Buffer, SymWord) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (((Buffer, SymWord) -> Identity (Buffer, SymWord))
    -> FrameState -> Identity FrameState)
-> ASetter VM VM (Buffer, SymWord) (Buffer, SymWord)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Buffer, SymWord) -> Identity (Buffer, SymWord))
-> FrameState -> Identity FrameState
Lens' FrameState (Buffer, SymWord)
calldata) (Buffer, SymWord)
cd
  ASetter VM VM SAddr SAddr -> SAddr -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((SAddr -> Identity SAddr) -> FrameState -> Identity FrameState)
-> ASetter VM VM SAddr SAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SAddr -> Identity SAddr) -> FrameState -> Identity FrameState
Lens' FrameState SAddr
caller) (Addr -> SAddr
litAddr Addr
testCaller)
  ((Word -> Identity Word) -> VM -> Identity VM) -> Word -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> FrameState -> Identity FrameState)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> FrameState -> Identity FrameState
Lens' FrameState Word
gas) (W256 -> Word
w256 W256
testGasCall)
  Contract
origin' <- Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe (ContractCode -> Contract
initialContract (Buffer -> ContractCode
RuntimeCode Buffer
forall a. Monoid a => a
mempty)) (Maybe Contract -> Contract)
-> StateT VM Identity (Maybe Contract)
-> StateT VM Identity Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Contract) VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
testOrigin)
  let originBal :: Word
originBal = Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
origin'
  Bool -> EVM () -> EVM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
originBal Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (W256 -> Word
w256 W256
testGasprice) Word -> Word -> Word
forall a. Num a => a -> a -> a
* (W256 -> Word
w256 W256
testGasCall)) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> EVM ()
forall a. HasCallStack => [Char] -> a
error [Char]
"insufficient balance for gas cost"
  VM
vm <- EVM VM
forall s (m :: * -> *). MonadState s m => m s
get
  VM -> EVM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (VM -> EVM ()) -> VM -> EVM ()
forall a b. (a -> b) -> a -> b
$ VM -> VM
initTx VM
vm

initialUnitTestVm :: UnitTestOptions -> SolcContract -> VM
initialUnitTestVm :: UnitTestOptions -> SolcContract -> VM
initialUnitTestVm (UnitTestOptions {Bool
Int
Maybe Int
Maybe Integer
Maybe (Text, ByteString)
Maybe Text
Maybe State
Text
DappInfo
TestVMParams
Query -> IO (EVM ())
VM -> VM
allowFFI :: Bool
testParams :: TestVMParams
dapp :: DappInfo
vmModifier :: VM -> VM
replay :: Maybe (Text, ByteString)
fuzzRuns :: Int
match :: Text
solver :: Maybe Text
smtState :: Maybe State
smtTimeout :: Maybe Integer
maxDepth :: Maybe Int
maxIter :: Maybe Integer
verbose :: Maybe Int
oracle :: Query -> IO (EVM ())
allowFFI :: UnitTestOptions -> Bool
testParams :: UnitTestOptions -> TestVMParams
dapp :: UnitTestOptions -> DappInfo
vmModifier :: UnitTestOptions -> VM -> VM
replay :: UnitTestOptions -> Maybe (Text, ByteString)
fuzzRuns :: UnitTestOptions -> Int
match :: UnitTestOptions -> Text
solver :: UnitTestOptions -> Maybe Text
smtState :: UnitTestOptions -> Maybe State
smtTimeout :: UnitTestOptions -> Maybe Integer
maxDepth :: UnitTestOptions -> Maybe Int
maxIter :: UnitTestOptions -> Maybe Integer
verbose :: UnitTestOptions -> Maybe Int
oracle :: UnitTestOptions -> Query -> IO (EVM ())
..}) SolcContract
theContract =
  let
    TestVMParams {Addr
W256
testChainId :: W256
testDifficulty :: W256
testMaxCodeSize :: W256
testGasprice :: W256
testGaslimit :: W256
testTimestamp :: W256
testNumber :: W256
testCoinbase :: Addr
testBalanceCall :: W256
testBalanceCreate :: W256
testGasCall :: W256
testGasCreate :: W256
testOrigin :: Addr
testCaller :: Addr
testAddress :: Addr
testChainId :: TestVMParams -> W256
testDifficulty :: TestVMParams -> W256
testMaxCodeSize :: TestVMParams -> W256
testGasprice :: TestVMParams -> W256
testGaslimit :: TestVMParams -> W256
testTimestamp :: TestVMParams -> W256
testNumber :: TestVMParams -> W256
testCoinbase :: TestVMParams -> Addr
testBalanceCall :: TestVMParams -> W256
testBalanceCreate :: TestVMParams -> W256
testGasCall :: TestVMParams -> W256
testGasCreate :: TestVMParams -> W256
testOrigin :: TestVMParams -> Addr
testCaller :: TestVMParams -> Addr
testAddress :: TestVMParams -> Addr
..} = TestVMParams
testParams
    vm :: VM
vm = VMOpts -> VM
makeVm (VMOpts -> VM) -> VMOpts -> VM
forall a b. (a -> b) -> a -> b
$ VMOpts :: Contract
-> (Buffer, SymWord)
-> SymWord
-> Addr
-> SAddr
-> Addr
-> W256
-> W256
-> W256
-> SymWord
-> Addr
-> W256
-> W256
-> W256
-> W256
-> FeeSchedule Integer
-> W256
-> Bool
-> StorageModel
-> Map Addr [W256]
-> Bool
-> VMOpts
VMOpts
           { vmoptContract :: Contract
vmoptContract = ContractCode -> Contract
initialContract (Buffer -> ContractCode
InitCode (ByteString -> Buffer
ConcreteBuffer (Getting ByteString SolcContract ByteString
-> SolcContract -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString SolcContract ByteString
Lens' SolcContract ByteString
creationCode SolcContract
theContract)))
           , vmoptCalldata :: (Buffer, SymWord)
vmoptCalldata = (Buffer
forall a. Monoid a => a
mempty, SymWord
0)
           , vmoptValue :: SymWord
vmoptValue = SymWord
0
           , vmoptAddress :: Addr
vmoptAddress = Addr
testAddress
           , vmoptCaller :: SAddr
vmoptCaller = Addr -> SAddr
litAddr Addr
testCaller
           , vmoptOrigin :: Addr
vmoptOrigin = Addr
testOrigin
           , vmoptGas :: W256
vmoptGas = W256
testGasCreate
           , vmoptGaslimit :: W256
vmoptGaslimit = W256
testGasCreate
           , vmoptCoinbase :: Addr
vmoptCoinbase = Addr
testCoinbase
           , vmoptNumber :: W256
vmoptNumber = W256
testNumber
           , vmoptTimestamp :: SymWord
vmoptTimestamp = Word -> SymWord
litWord (Word -> SymWord) -> Word -> SymWord
forall a b. (a -> b) -> a -> b
$ W256 -> Word
w256 W256
testTimestamp
           , vmoptBlockGaslimit :: W256
vmoptBlockGaslimit = W256
testGaslimit
           , vmoptGasprice :: W256
vmoptGasprice = W256
testGasprice
           , vmoptMaxCodeSize :: W256
vmoptMaxCodeSize = W256
testMaxCodeSize
           , vmoptDifficulty :: W256
vmoptDifficulty = W256
testDifficulty
           , vmoptSchedule :: FeeSchedule Integer
vmoptSchedule = FeeSchedule Integer
forall n. Num n => FeeSchedule n
FeeSchedule.berlin
           , vmoptChainId :: W256
vmoptChainId = W256
testChainId
           , vmoptCreate :: Bool
vmoptCreate = Bool
True
           , vmoptStorageModel :: StorageModel
vmoptStorageModel = StorageModel
ConcreteS -- TODO: support RPC
           , vmoptTxAccessList :: Map Addr [W256]
vmoptTxAccessList = Map Addr [W256]
forall a. Monoid a => a
mempty -- TODO: support unit test access lists???
           , vmoptAllowFFI :: Bool
vmoptAllowFFI = Bool
allowFFI
           }
    creator :: Contract
creator =
      ContractCode -> Contract
initialContract (Buffer -> ContractCode
RuntimeCode Buffer
forall a. Monoid a => a
mempty)
        Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ((Word -> Identity Word) -> Contract -> Identity Contract)
-> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
nonce Word
1
        Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ((Word -> Identity Word) -> Contract -> Identity Contract)
-> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
balance (W256 -> Word
w256 W256
testBalanceCreate)
  in VM
vm
    VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
ethrunAddress) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
creator)


-- | takes a concrete VM and makes all storage symbolic
symbolify :: VM -> VM
symbolify :: VM -> VM
symbolify VM
vm =
  VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Storage Storage -> (Storage -> Storage) -> VM -> VM
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Env -> Identity Env)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Storage -> Identity Storage)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract)
forall s t a b. Each s t a b => Traversal s t a b
each ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Storage -> Identity Storage) -> Contract -> Identity Contract)
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Storage -> Identity Storage) -> Contract -> Identity Contract
Lens' Contract Storage
storage) Storage -> Storage
mkSymStorage
     VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM StorageModel StorageModel -> StorageModel -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((StorageModel -> Identity StorageModel) -> Env -> Identity Env)
-> ASetter VM VM StorageModel StorageModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageModel -> Identity StorageModel) -> Env -> Identity Env
Lens' Env StorageModel
storageModel) StorageModel
InitialS
  where
    mkSymStorage :: Storage -> Storage
    mkSymStorage :: Storage -> Storage
mkSymStorage (Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
_) = [Char] -> Storage
forall a. HasCallStack => [Char] -> a
error [Char]
"should not happen"
    mkSymStorage (Concrete Map Word SymWord
s) =
      let
        list :: [(SWord 256, SWord 256)]
list = [(WordN 256 -> SWord 256
forall a. SymVal a => a -> SBV a
literal (WordN 256 -> SWord 256) -> WordN 256 -> SWord 256
forall a b. (a -> b) -> a -> b
$ W256 -> ToSizzle W256
forall a. ToSizzleBV a => a -> ToSizzle a
toSizzle W256
k, SWord 256
v) | (C Whiff
_ W256
k, S Whiff
_ SWord 256
v) <- Map Word SymWord -> [(Word, SymWord)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Word SymWord
s]
        symlist :: [(SymWord, SymWord)]
symlist = [(Word -> SymWord
litWord Word
k, SymWord
v) | (Word
k, SymWord
v) <- Map Word SymWord -> [(Word, SymWord)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Word SymWord
s]
      in [(SymWord, SymWord)] -> SArray (WordN 256) (WordN 256) -> Storage
Symbolic [(SymWord, SymWord)]
symlist (SArray (WordN 256) (WordN 256) -> Storage)
-> SArray (WordN 256) (WordN 256) -> Storage
forall a b. (a -> b) -> a -> b
$ WordN 256
-> [(SWord 256, SWord 256)] -> SArray (WordN 256) (WordN 256)
forall (array :: * -> * -> *) a b.
(SymArray array, HasKind a, SymVal b) =>
b -> [(SBV a, SBV b)] -> array a b
sListArray WordN 256
0 [(SWord 256, SWord 256)]
list

getParametersFromEnvironmentVariables :: Maybe Text -> IO TestVMParams
getParametersFromEnvironmentVariables :: Maybe Text -> IO TestVMParams
getParametersFromEnvironmentVariables Maybe Text
rpc = do
  BlockNumber
block' <- BlockNumber
-> ([Char] -> BlockNumber) -> Maybe [Char] -> BlockNumber
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BlockNumber
EVM.Fetch.Latest (W256 -> BlockNumber
EVM.Fetch.BlockNumber (W256 -> BlockNumber) -> ([Char] -> W256) -> [Char] -> BlockNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> W256
forall a. Read a => [Char] -> a
read) (Maybe [Char] -> BlockNumber)
-> IO (Maybe [Char]) -> IO BlockNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO (Maybe [Char])
lookupEnv [Char]
"DAPP_TEST_NUMBER")

  (Addr
miner,W256
ts,W256
blockNum,W256
diff) <-
    case Maybe Text
rpc of
      Maybe Text
Nothing  -> (Addr, W256, W256, W256) -> IO (Addr, W256, W256, W256)
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
0,W256
0,W256
0,W256
0)
      Just Text
url -> BlockNumber -> Text -> IO (Maybe Block)
EVM.Fetch.fetchBlockFrom BlockNumber
block' Text
url IO (Maybe Block)
-> (Maybe Block -> IO (Addr, W256, W256, W256))
-> IO (Addr, W256, W256, W256)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Block
Nothing -> [Char] -> IO (Addr, W256, W256, W256)
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not fetch block"
        Just EVM.Block{FeeSchedule Integer
Addr
SymWord
Word
_schedule :: Block -> FeeSchedule Integer
_maxCodeSize :: Block -> Word
_gaslimit :: Block -> Word
_difficulty :: Block -> Word
_number :: Block -> Word
_timestamp :: Block -> SymWord
_coinbase :: Block -> Addr
_schedule :: FeeSchedule Integer
_maxCodeSize :: Word
_gaslimit :: Word
_difficulty :: Word
_number :: Word
_timestamp :: SymWord
_coinbase :: Addr
..} -> (Addr, W256, W256, W256) -> IO (Addr, W256, W256, W256)
forall (m :: * -> *) a. Monad m => a -> m a
return (  Addr
_coinbase
                                      , Word -> W256
wordValue (Word -> W256) -> Word -> W256
forall a b. (a -> b) -> a -> b
$ SymWord -> Word
forceLit SymWord
_timestamp
                                      , Word -> W256
wordValue Word
_number
                                      , Word -> W256
wordValue Word
_difficulty
                                      )
  let
    getWord :: [Char] -> b -> IO b
getWord [Char]
s b
def = b -> ([Char] -> b) -> Maybe [Char] -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
def [Char] -> b
forall a. Read a => [Char] -> a
read (Maybe [Char] -> b) -> IO (Maybe [Char]) -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
s
    getAddr :: [Char] -> b -> IO b
getAddr [Char]
s b
def = b -> ([Char] -> b) -> Maybe [Char] -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
def [Char] -> b
forall a. Read a => [Char] -> a
read (Maybe [Char] -> b) -> IO (Maybe [Char]) -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
s

  Addr
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> W256
-> W256
-> TestVMParams
TestVMParams
    (Addr
 -> Addr
 -> Addr
 -> W256
 -> W256
 -> W256
 -> W256
 -> Addr
 -> W256
 -> W256
 -> W256
 -> W256
 -> W256
 -> W256
 -> W256
 -> TestVMParams)
-> IO Addr
-> IO
     (Addr
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Addr -> IO Addr
forall b. Read b => [Char] -> b -> IO b
getAddr [Char]
"DAPP_TEST_ADDRESS" (Addr -> W256 -> Addr
createAddress Addr
ethrunAddress W256
1)
    IO
  (Addr
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO Addr
-> IO
     (Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Addr -> IO Addr
forall b. Read b => [Char] -> b -> IO b
getAddr [Char]
"DAPP_TEST_CALLER" Addr
ethrunAddress
    IO
  (Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO Addr
-> IO
     (W256
      -> W256
      -> W256
      -> W256
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Addr -> IO Addr
forall b. Read b => [Char] -> b -> IO b
getAddr [Char]
"DAPP_TEST_ORIGIN" Addr
ethrunAddress
    IO
  (W256
   -> W256
   -> W256
   -> W256
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO W256
-> IO
     (W256
      -> W256
      -> W256
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_GAS_CREATE" W256
defaultGasForCreating
    IO
  (W256
   -> W256
   -> W256
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO W256
-> IO
     (W256
      -> W256
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_GAS_CALL" W256
defaultGasForInvoking
    IO
  (W256
   -> W256
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO W256
-> IO
     (W256
      -> Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_BALANCE_CREATE" W256
defaultBalanceForCreator
    IO
  (W256
   -> Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO W256
-> IO
     (Addr
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> W256
      -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_BALANCE_CALL" W256
defaultBalanceForCreated
    IO
  (Addr
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> W256
   -> TestVMParams)
-> IO Addr
-> IO
     (W256
      -> W256 -> W256 -> W256 -> W256 -> W256 -> W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Addr -> IO Addr
forall b. Read b => [Char] -> b -> IO b
getAddr [Char]
"DAPP_TEST_COINBASE" Addr
miner
    IO
  (W256
   -> W256 -> W256 -> W256 -> W256 -> W256 -> W256 -> TestVMParams)
-> IO W256
-> IO
     (W256 -> W256 -> W256 -> W256 -> W256 -> W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_NUMBER" W256
blockNum
    IO (W256 -> W256 -> W256 -> W256 -> W256 -> W256 -> TestVMParams)
-> IO W256
-> IO (W256 -> W256 -> W256 -> W256 -> W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_TIMESTAMP" W256
ts
    IO (W256 -> W256 -> W256 -> W256 -> W256 -> TestVMParams)
-> IO W256 -> IO (W256 -> W256 -> W256 -> W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_GAS_LIMIT" W256
0
    IO (W256 -> W256 -> W256 -> W256 -> TestVMParams)
-> IO W256 -> IO (W256 -> W256 -> W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_GAS_PRICE" W256
0
    IO (W256 -> W256 -> W256 -> TestVMParams)
-> IO W256 -> IO (W256 -> W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_MAXCODESIZE" W256
defaultMaxCodeSize
    IO (W256 -> W256 -> TestVMParams)
-> IO W256 -> IO (W256 -> TestVMParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_DIFFICULTY" W256
diff
    IO (W256 -> TestVMParams) -> IO W256 -> IO TestVMParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> W256 -> IO W256
forall b. Read b => [Char] -> b -> IO b
getWord [Char]
"DAPP_TEST_CHAINID" W256
99