{-# 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
  --T.writeFile "output.json" json
  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
  --TIO.writeFile "output.json" json
  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)