{-# Language QuasiQuotes #-}
module EVM.TestUtils where
import Data.Text
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Paths_hevm as Paths
import Data.String.Here
import System.Directory
import System.IO.Temp
import GHC.IO.Handle (hClose)
import System.Process (readProcess)
import EVM.Solidity
import EVM.SMT
import EVM.Dapp
import EVM.UnitTest
import EVM.Fetch (RpcInfo)
import qualified EVM.TTY as TTY
runDappTestCustom :: FilePath -> Text -> Maybe Integer -> Bool -> RpcInfo -> IO Bool
runDappTestCustom :: String -> Text -> Maybe Integer -> Bool -> RpcInfo -> IO Bool
runDappTestCustom String
testFile Text
match Maybe Integer
maxIter Bool
ffiAllowed RpcInfo
rpcinfo = do
String
root <- IO String
Paths.getDataDir
(Text
json, Text
_) <- String -> IO (Text, Text)
compileWithDSTest String
testFile
String -> IO Bool -> IO Bool
forall a. String -> IO a -> IO a
withCurrentDirectory String
root (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
String -> (String -> Handle -> IO Bool) -> IO Bool
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"output.json" ((String -> Handle -> IO Bool) -> IO Bool)
-> (String -> Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \String
file Handle
handle -> do
Handle -> IO ()
hClose Handle
handle
String -> Text -> IO ()
T.writeFile String
file Text
json
Solver
-> Natural -> Maybe Natural -> (SolverGroup -> IO Bool) -> IO Bool
forall a.
Solver -> Natural -> Maybe Natural -> (SolverGroup -> IO a) -> IO a
withSolvers Solver
Z3 Natural
1 Maybe Natural
forall a. Maybe a
Nothing ((SolverGroup -> IO Bool) -> IO Bool)
-> (SolverGroup -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \SolverGroup
solvers -> do
UnitTestOptions
opts <- SolverGroup
-> String
-> Text
-> Text
-> Maybe Integer
-> Bool
-> RpcInfo
-> IO UnitTestOptions
testOpts SolverGroup
solvers String
root Text
json Text
match Maybe Integer
maxIter Bool
ffiAllowed RpcInfo
rpcinfo
UnitTestOptions -> String -> Maybe String -> IO Bool
dappTest UnitTestOptions
opts String
file Maybe String
forall a. Maybe a
Nothing
runDappTest :: FilePath -> Text -> IO Bool
runDappTest :: String -> Text -> IO Bool
runDappTest String
testFile Text
match = String -> Text -> Maybe Integer -> Bool -> RpcInfo -> IO Bool
runDappTestCustom String
testFile Text
match Maybe Integer
forall a. Maybe a
Nothing Bool
True RpcInfo
forall a. Maybe a
Nothing
debugDappTest :: FilePath -> RpcInfo -> IO ()
debugDappTest :: String -> RpcInfo -> IO ()
debugDappTest String
testFile RpcInfo
rpcinfo = do
String
root <- IO String
Paths.getDataDir
(Text
json, Text
_) <- String -> IO (Text, Text)
compileWithDSTest String
testFile
String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
root (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> (String -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"output.json" ((String -> Handle -> IO ()) -> IO ())
-> (String -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file Handle
handle -> do
Handle -> IO ()
hClose Handle
handle
String -> Text -> IO ()
T.writeFile String
file Text
json
Solver
-> Natural -> Maybe Natural -> (SolverGroup -> IO ()) -> IO ()
forall a.
Solver -> Natural -> Maybe Natural -> (SolverGroup -> IO a) -> IO a
withSolvers Solver
Z3 Natural
1 Maybe Natural
forall a. Maybe a
Nothing ((SolverGroup -> IO ()) -> IO ())
-> (SolverGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SolverGroup
solvers -> do
UnitTestOptions
opts <- SolverGroup
-> String
-> Text
-> Text
-> Maybe Integer
-> Bool
-> RpcInfo
-> IO UnitTestOptions
testOpts SolverGroup
solvers String
root Text
json Text
".*" Maybe Integer
forall a. Maybe a
Nothing Bool
True RpcInfo
rpcinfo
UnitTestOptions -> String -> String -> IO ()
TTY.main UnitTestOptions
opts String
root String
file
testOpts :: SolverGroup -> FilePath -> Text -> Text -> Maybe Integer -> Bool -> RpcInfo -> IO UnitTestOptions
testOpts :: SolverGroup
-> String
-> Text
-> Text
-> Maybe Integer
-> Bool
-> RpcInfo
-> IO UnitTestOptions
testOpts SolverGroup
solvers String
root Text
solcJson Text
match Maybe Integer
maxIter Bool
allowFFI RpcInfo
rpcinfo = do
DappInfo
srcInfo <- case Text
-> Maybe
(Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
solcJson of
Maybe
(Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
Nothing -> String -> IO DappInfo
forall a. HasCallStack => String -> a
error String
"Could not read solc json"
Just (Map Text SolcContract
contractMap, Map Text Value
asts, [(Text, Maybe ByteString)]
sources) -> do
SourceCache
sourceCache <- [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache
makeSourceCache [(Text, Maybe ByteString)]
sources Map Text Value
asts
DappInfo -> IO DappInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DappInfo -> IO DappInfo) -> DappInfo -> IO DappInfo
forall a b. (a -> b) -> a -> b
$ String -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo String
root Map Text SolcContract
contractMap SourceCache
sourceCache
TestVMParams
params <- Maybe Text -> IO TestVMParams
getParametersFromEnvironmentVariables Maybe Text
forall a. Maybe a
Nothing
UnitTestOptions -> IO UnitTestOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitTestOptions :: RpcInfo
-> SolverGroup
-> Maybe Int
-> Maybe Integer
-> Maybe Integer
-> Bool
-> Maybe Int
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Text
-> Int
-> Maybe (Text, ByteString)
-> (VM -> VM)
-> DappInfo
-> TestVMParams
-> Bool
-> UnitTestOptions
UnitTestOptions
{ solvers :: SolverGroup
solvers = SolverGroup
solvers
, rpcInfo :: RpcInfo
rpcInfo = RpcInfo
rpcinfo
, maxIter :: Maybe Integer
maxIter = Maybe Integer
maxIter
, askSmtIters :: Maybe Integer
askSmtIters = Maybe Integer
forall a. Maybe a
Nothing
, smtDebug :: Bool
smtDebug = Bool
False
, smtTimeout :: Maybe Natural
smtTimeout = Maybe Natural
forall a. Maybe a
Nothing
, solver :: Maybe Text
solver = Maybe Text
forall a. Maybe a
Nothing
, covMatch :: Maybe Text
covMatch = Maybe Text
forall a. Maybe a
Nothing
, verbose :: Maybe Int
verbose = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
, match :: Text
match = Text
match
, maxDepth :: Maybe Int
maxDepth = Maybe Int
forall a. Maybe a
Nothing
, fuzzRuns :: Int
fuzzRuns = Int
100
, replay :: Maybe (Text, ByteString)
replay = Maybe (Text, ByteString)
forall a. Maybe a
Nothing
, vmModifier :: VM -> VM
vmModifier = VM -> VM
forall a. a -> a
id
, testParams :: TestVMParams
testParams = TestVMParams
params
, dapp :: DappInfo
dapp = DappInfo
srcInfo
, ffiAllowed :: Bool
ffiAllowed = Bool
allowFFI
}
compileWithDSTest :: FilePath -> IO (Text, Text)
compileWithDSTest :: String -> IO (Text, Text)
compileWithDSTest String
src =
String -> (String -> Handle -> IO (Text, Text)) -> IO (Text, Text)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"input.json" ((String -> Handle -> IO (Text, Text)) -> IO (Text, Text))
-> (String -> Handle -> IO (Text, Text)) -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ \String
file Handle
handle -> do
Handle -> IO ()
hClose Handle
handle
String
dsTest <- String -> IO String
readFile (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
Paths.getDataFileName String
"test/contracts/lib/test.sol"
String
erc20 <- String -> IO String
readFile (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
Paths.getDataFileName String
"test/contracts/lib/erc20.sol"
String
testFilePath <- String -> IO String
Paths.getDataFileName String
src
String
testFile <- String -> IO String
readFile String
testFilePath
String -> Text -> IO ()
T.writeFile String
file
[i|
{
"language": "Solidity",
"sources": {
"ds-test/test.sol": {
"content": ${dsTest}
},
"lib/erc20.sol": {
"content": ${erc20}
},
"test.sol": {
"content": ${testFile}
}
},
"settings": {
"metadata": {
"useLiteralContent": true
},
"outputSelection": {
"*": {
"*": [
"metadata",
"evm.bytecode",
"evm.deployedBytecode",
"abi",
"storageLayout",
"evm.bytecode.sourceMap",
"evm.bytecode.linkReferences",
"evm.bytecode.generatedSources",
"evm.deployedBytecode.sourceMap",
"evm.deployedBytecode.linkReferences",
"evm.deployedBytecode.generatedSources"
],
"": [
"ast"
]
}
}
}
}
|]
Text
x <- String -> Text
T.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> [String] -> String -> IO String
readProcess
String
"solc"
[String
"--allow-paths", String
file, String
"--standard-json", String
file]
String
""
(Text, Text) -> IO (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, String -> Text
T.pack String
testFilePath)