module EVM.Test.Utils where import Data.Text (Text) import Data.List (isInfixOf) import GHC.IO.Exception (IOErrorType(..)) import GHC.Natural import Paths_hevm qualified as Paths import System.Directory import System.FilePath (()) import System.IO.Temp import System.Process import System.Exit import System.IO.Error (mkIOError) import EVM.Dapp (dappInfo, emptyDapp) import EVM.Fetch (RpcInfo) import EVM.Solidity import EVM.Solvers import EVM.UnitTest import Control.Monad.ST (RealWorld) import Control.Monad.IO.Unlift import Control.Monad.Catch (MonadMask) import EVM.Effects import Data.Maybe (fromMaybe) import EVM.Types (internalError) import System.Environment (lookupEnv) -- Returns tuple of (No cex, No warnings) runSolidityTestCustom :: (MonadMask m, App m) => FilePath -> Text -> Maybe Natural -> Maybe Integer -> Bool -> RpcInfo -> ProjectType -> m (Bool, Bool) runSolidityTestCustom testFile match timeout maxIter ffiAllowed rpcinfo projectType = do withSystemTempDirectory "dapp-test" $ \root -> do (compile projectType root testFile) >>= \case Left e -> liftIO $ do putStrLn e internalError $ "Error compiling test file " <> show testFile <> " in directory " <> show root <> " using project type " <> show projectType Right bo@(BuildOutput contracts _) -> do withSolvers Bitwuzla 3 1 timeout $ \solvers -> do opts <- liftIO $ testOpts solvers root (Just bo) match maxIter ffiAllowed rpcinfo unitTest opts contracts -- Returns tuple of (No cex, No warnings) runSolidityTest :: (MonadMask m, App m) => FilePath -> Text -> m (Bool, Bool) runSolidityTest testFile match = runSolidityTestCustom testFile match Nothing Nothing True Nothing Foundry testOpts :: SolverGroup -> FilePath -> Maybe BuildOutput -> Text -> Maybe Integer -> Bool -> RpcInfo -> IO (UnitTestOptions RealWorld) testOpts solvers root buildOutput match maxIter allowFFI rpcinfo = do let srcInfo = maybe emptyDapp (dappInfo root) buildOutput params <- paramsFromRpc rpcinfo pure UnitTestOptions { solvers = solvers , rpcInfo = rpcinfo , maxIter = maxIter , askSmtIters = 1 , smtTimeout = Nothing , match = match , prefix = "prove" , testParams = params , dapp = srcInfo , ffiAllowed = allowFFI , checkFailBit = False } processFailedException :: String -> String -> [String] -> Int -> IO a processFailedException fun cmd args exit_code = ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++ concatMap ((' ':) . show) args ++ " (exit " ++ show exit_code ++ ")") Nothing Nothing) callProcessCwd :: FilePath -> [String] -> FilePath -> IO () callProcessCwd cmd args cwd = do exit_code <- withCreateProcess (proc cmd args) { cwd = Just cwd, delegate_ctlc = True } $ \_ _ _ p -> waitForProcess p case exit_code of ExitSuccess -> pure () ExitFailure r -> processFailedException "callProcess" cmd args r compile :: App m => ProjectType -> FilePath -> FilePath -> m (Either String BuildOutput) compile CombinedJSON _root _src = internalError "unsupported compile type: CombinedJSON" compile _ root src = do liftIO $ createDirectory (root "src") liftIO $ writeFile (root "src" "unit-tests.t.sol") =<< readFile =<< Paths.getDataFileName src liftIO $ initLib (root "lib" "tokens") ("test" "contracts" "lib" "erc20.sol") "erc20.sol" liftIO $ initStdForgeDir (root "lib" "forge-std") (res,out,err) <- liftIO $ readProcessWithExitCode "forge" ["build", "--ast", "--root", root] "" case res of ExitFailure _ -> pure . Left $ "compilation failed: " <> "exit code: " <> show res <> "\n\nstdout:\n" <> out <> "\n\nstderr:\n" <> err ExitSuccess -> readFilteredBuildOutput root (\path -> "unit-tests.t.sol" `Data.List.isInfixOf` path) Foundry where initStdForgeDir :: FilePath -> IO () initStdForgeDir tld = do createDirectoryIfMissing True tld forgeStdRepo <- liftIO $ fromMaybe (internalError "cannot find forge-std repo") <$> (lookupEnv "HEVM_FORGE_STD_REPO") callProcess "mkdir" ["-p", tld] callProcess "cp" ["-r", forgeStdRepo "src", tld "src"] initLib :: FilePath -> FilePath -> FilePath -> IO () initLib tld srcFile dstFile = do createDirectoryIfMissing True (tld "src") writeFile (tld "src" dstFile) =<< readFile =<< Paths.getDataFileName srcFile pure ()