Merge pull request #510 from ethereum/update-foundry

Update `forge` to more recent version

CHANGELOG.md

@@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - ARM64 and x86_64 Mac along with Linux x86_64 static binaries for releases
 - PAnd props are now recursively flattened
 - Double negation in Prop are removed
+- Updated forge to modern version, thereby fixing JSON parsing of new forge JSONs
 
 ## Fixed
 - `concat` is a 2-ary, not an n-ary function in SMT2LIB, declare-const does not exist in QF_AUFBV, replacing

bench/bench.hs

@@ -22,6 +22,7 @@ import EVM.Solidity
 import EVM.Solvers
 import EVM.Effects
 import EVM.Format (hexByteString)
+import EVM.UnitTest (writeTrace)
 import qualified EVM.Stepper as Stepper
 import qualified EVM.Fetch as Fetch
 

cli/cli.hs

@@ -225,7 +225,7 @@ main = withUtf8 $ do
  cores <- liftIO $ unsafeInto <$> getNumProcessors
  let solverCount = fromMaybe cores cmd.numSolvers
  runEnv env $ withSolvers solver solverCount cmd.smttimeout $ \solvers -> do
- buildOut <- liftIO $ readBuildOutput root (getProjectType cmd)
+ buildOut <- readBuildOutput root (getProjectType cmd)
  case buildOut of
  Left e -> liftIO $ do
  putStrLn $ "Error: " <> e
@@ -275,14 +275,15 @@ getSolver cmd = case cmd.solver of
  putStrLn $ "unrecognised solver: " <> input
  exitFailure
 
-getSrcInfo :: Command Options.Unwrapped -> IO DappInfo
+getSrcInfo :: App m => Command Options.Unwrapped -> m DappInfo
 getSrcInfo cmd = do
- root <- getRoot cmd
- withCurrentDirectory root $ do
+ root <- liftIO $ getRoot cmd
+ conf <- readConfig
+ liftIO $ withCurrentDirectory root $ do
  outExists <- doesDirectoryExist (root </> "out")
  if outExists
  then do
- buildOutput <- readBuildOutput root (getProjectType cmd)
+ buildOutput <- runEnv Env {config = conf} $ readBuildOutput root (getProjectType cmd)
  case buildOutput of
  Left _ -> pure emptyDapp
  Right o -> pure $ dappInfo root o
@@ -381,7 +382,7 @@ areAnyPrefixOf prefixes t = any (flip T.isPrefixOf t) prefixes
 
 launchExec :: App m => Command Options.Unwrapped -> m ()
 launchExec cmd = do
- dapp <- liftIO $ getSrcInfo cmd
+ dapp <- getSrcInfo cmd
  vm <- liftIO $ vmFromCommand cmd
  let
  block = maybe Fetch.Latest Fetch.BlockNumber cmd.block

doc/src/ds-test-tutorial.md

@@ -98,7 +98,24 @@ contract MyContract is Test {
 }
 ```
 
-After compiling with `forge build`, when ran under hevm, we get:
+When compiling our foundry project, we must either always pass the `--ast` flag
+to `forge build`, or, much better, set the `ast = true` flag in the
+`foundry.toml` file:
+
+```toml
+ast = true
+```
+
+In case neither `--ast` was passed, nor `ast = true` was set in the
+`foundry.toml` file, we will get an error such as:
+
+```
+Error: unable to parse Foundry project JSON: [...]/out/Base.sol/CommonBase.json Contract: "CommonBase"
+```
+
+In these cases, issue `forge clean` and run `forge build --ast` again.
+
+Once the project has been correctly built, we can run `hevm test`, and get:
 
 ```
 $ hevm test

doc/src/getting-started.md

@@ -79,7 +79,7 @@ contract MyContract is DSTest {
  }
 }
 EOF
-$ forge build
+$ forge build --ast
 [⠊] Compiling...
 [⠒] Compiling 1 files with 0.8.19
 [⠢] Solc 0.8.19 finished in 14.27ms
@@ -118,7 +118,7 @@ should now say:
 Let's re-build with forge and check with hevm once again:
 
 ```shell
-$ forge build
+$ forge build --ast
 [⠰] Compiling...
 [⠔] Compiling 1 files with 0.8.19
 [⠒] Solc 0.8.19 finished in 985.32ms

doc/src/install.md

@@ -25,7 +25,7 @@ put it in your path so it can be executed via typing "hevm".
 Once you have the above, you can go to the root of your forge-based project
 and build it:
 ```
-$ forge build
+$ forge build --ast
 [⠒] Compiling...
 [⠆] Compiling 34 files with 0.8.19
 [⠔] Solc 0.8.19 finished in 2.12s

src/EVM/Effects.hs

@@ -16,19 +16,12 @@ only.
 
 module EVM.Effects where
 
-import Control.Monad (when)
-import Control.Monad.IO.Unlift (MonadIO(liftIO), MonadUnliftIO)
-import Control.Monad.Reader (ReaderT, runReaderT, ask)
-import Control.Monad.ST (RealWorld)
+import Control.Monad.Reader
+import Control.Monad.IO.Unlift
 import Data.Text (Text)
 import Data.Text.IO qualified as T
 import System.IO (stderr)
 
-import EVM (traceForest)
-import EVM.Dapp (DappInfo)
-import EVM.Format (showTraceTree)
-import EVM.Types (VM(..))
-
 
 -- Abstract Effects --------------------------------------------------------------------------------
 -- Here we define the abstract interface for the effects that we wish to model
@@ -74,17 +67,6 @@ class Monad m => TTY m where
  writeOutput :: Text -> m ()
  writeErr :: Text -> m ()
 
-writeTraceDapp :: App m => DappInfo -> VM t RealWorld -> m ()
-writeTraceDapp dapp vm = do
- conf <- readConfig
- liftIO $ when conf.dumpTrace $ T.writeFile "VM.trace" (showTraceTree dapp vm)
-
-writeTrace :: App m => VM t RealWorld -> m ()
-writeTrace vm = do
- conf <- readConfig
- liftIO $ when conf.dumpTrace $ writeFile "VM.trace" (show $ traceForest vm)
-
-
 -- IO Interpretation -------------------------------------------------------------------------------
 
 

src/EVM/Solidity.hs

@@ -45,6 +45,7 @@ import EVM.Types hiding (Success)
 
 import Optics.Core
 import Optics.Operators.Unsafe
+import EVM.Effects;
 
 import Control.Applicative
 import Control.Monad
@@ -283,34 +284,39 @@ makeSrcMaps = (\case (_, Fe, _) -> Nothing; x -> Just (done x))
  go c (xs, state, p) = (xs, internalError ("srcmap: y u " ++ show c ++ " in state" ++ show state ++ "?!?"), p)
 
 -- | Reads all solc output json files found under the provided filepath and returns them merged into a BuildOutput
-readBuildOutput :: FilePath -> ProjectType -> IO (Either String BuildOutput)
+readBuildOutput :: App m => FilePath -> ProjectType -> m (Either String BuildOutput)
 readBuildOutput root DappTools = do
  let outDir = root </> "out"
- jsons <- findJsonFiles outDir
+ jsons <- liftIO $ findJsonFiles outDir
  case jsons of
  [x] -> readSolc DappTools root (outDir </> x)
  [] -> pure . Left $ "no json files found in: " <> outDir
  _ -> pure . Left $ "multiple json files found in: " <> outDir
 readBuildOutput root CombinedJSON = do
  let outDir = root </> "out"
- jsons <- findJsonFiles outDir
+ jsons <- liftIO $ findJsonFiles outDir
  case jsons of
  [x] -> readSolc CombinedJSON root (outDir </> x)
  [] -> pure . Left $ "no json files found in: " <> outDir
  _ -> pure . Left $ "multiple json files found in: " <> outDir
 readBuildOutput root _ = do
  let outDir = root </> "out"
- jsons <- findJsonFiles outDir
+ jsons <- liftIO $ findJsonFiles outDir
  case (filterMetadata jsons) of
  [] -> pure . Left $ "no json files found in: " <> outDir
  js -> do
  outputs <- sequence <$> mapM (readSolc Foundry root) ((fmap ((</>) (outDir))) js)
  pure . (fmap mconcat) $ outputs
 
 -- | Finds all json files under the provided filepath, searches recursively
+-- Filtering out: * "kompiled" which gets added to `out` by `kontrol`
+-- * "build-info" which gets added by forge
 findJsonFiles :: FilePath -> IO [FilePath]
-findJsonFiles root = filter (not . isInfixOf "kompiled") -- HACK: this gets added to `out` by `kontrol`
+findJsonFiles root = filter (doesNotContain ["build-info", "kompiled"])
  <$> getDirectoryFiles root ["**/*.json"]
+ where
+ doesNotContain :: [String] -> String -> Bool
+ doesNotContain forbiddenStrs str = all (\forbidden -> not (isInfixOf forbidden str)) forbiddenStrs
 
 -- | Filters out metadata json files
 filterMetadata :: [FilePath] -> [FilePath]
@@ -342,17 +348,19 @@ lineSubrange xs (s1, n1) i =
  then Nothing
  else Just (s1 - s2, min (s2 + n2 - s1) n1)
 
-readSolc :: ProjectType -> FilePath -> FilePath -> IO (Either String BuildOutput)
+readSolc :: App m => ProjectType -> FilePath -> FilePath -> m (Either String BuildOutput)
 readSolc pt root fp = do
  -- NOTE: we cannot and must not use Data.Text.IO.readFile because that takes the locale
  -- and may fail with very strange errors when the JSON it's reading
  -- contains any UTF-8 character -- which it will with foundry
- fileContents <- fmap Data.Text.Encoding.decodeUtf8 $ Data.ByteString.readFile fp
+ fileContents <- liftIO $ fmap Data.Text.Encoding.decodeUtf8 $ Data.ByteString.readFile fp
  let contractName = T.pack $ takeBaseName fp
  case readJSON pt contractName fileContents of
- Nothing -> pure . Left $ "unable to parse " <> show pt <> " project JSON: " <> fp
+ Nothing -> pure . Left $ "unable to parse " <> show pt <> " project JSON: " <> fp <> " Contract: " <> show contractName
  Just (contracts, asts, sources) -> do
- sourceCache <- makeSourceCache root sources asts
+ conf <- readConfig
+ when (conf.debug) $ liftIO $ putStrLn $ "Parsed constract: " <> show contractName <> " file: " <> fp
+ sourceCache <- liftIO $ makeSourceCache root sources asts
  pure (Right (BuildOutput contracts sourceCache))
 
 yul :: Text -> Text -> IO (Maybe ByteString)

src/EVM/UnitTest.hs

@@ -20,6 +20,7 @@ import EVM.Types
 import EVM.Transaction (initTx)
 import EVM.Stepper (Stepper)
 import EVM.Stepper qualified as Stepper
+import Data.Text.IO qualified as T
 
 import Control.Monad (void, when, forM)
 import Control.Monad.ST (RealWorld, ST, stToIO)
@@ -91,6 +92,16 @@ defaultMaxCodeSize = 0xffffffff
 
 type ABIMethod = Text
 
+-- | Used in various places for dumping traces
+writeTraceDapp :: App m => DappInfo -> VM t RealWorld -> m ()
+writeTraceDapp dapp vm = do
+ conf <- readConfig
+ liftIO $ when conf.dumpTrace $ T.writeFile "VM.trace" (showTraceTree dapp vm)
+
+writeTrace :: App m => VM t RealWorld -> m ()
+writeTrace vm = do
+ conf <- readConfig
+ liftIO $ when conf.dumpTrace $ writeFile "VM.trace" (show $ traceForest vm)
 
 -- | Generate VeriOpts from UnitTestOptions
 makeVeriOpts :: UnitTestOptions s -> VeriOpts

test/EVM/Test/BlockchainTests.hs

@@ -7,6 +7,7 @@ import EVM.Fetch qualified
 import EVM.Format (hexText)
 import EVM.Stepper qualified
 import EVM.Transaction
+import EVM.UnitTest (writeTrace)
 import EVM.Types hiding (Block, Case, Env)
 import EVM.Test.Tracing (interpretWithTrace, VMTrace, compareTraces, EVMToolTraceOutput(..))
 

test/EVM/Test/Utils.hs

@@ -33,7 +33,7 @@ runSolidityTestCustom
  => FilePath -> Text -> Maybe Natural -> Maybe Integer -> Bool -> RpcInfo -> ProjectType -> m Bool
 runSolidityTestCustom testFile match timeout maxIter ffiAllowed rpcinfo projectType = do
  withSystemTempDirectory "dapp-test" $ \root -> do
- (liftIO $ compile projectType root testFile) >>= \case
+ (compile projectType root testFile) >>= \case
  Left e -> error e
  Right bo@(BuildOutput contracts _) -> do
  withSolvers Z3 1 timeout $ \solvers -> do
@@ -65,22 +65,22 @@ testOpts solvers root buildOutput match maxIter allowFFI rpcinfo = do
  , ffiAllowed = allowFFI
  }
 
-compile :: ProjectType -> FilePath -> FilePath -> IO (Either String BuildOutput)
+compile :: App m => ProjectType -> FilePath -> FilePath -> m (Either String BuildOutput)
 compile DappTools root src = do
- json <- compileWithDSTest src
- createDirectory (root </> "out")
- T.writeFile (root </> "out" </> "dapp.sol.json") json
+ json <- liftIO $ compileWithDSTest src
+ liftIO $ createDirectory (root </> "out")
+ liftIO $ T.writeFile (root </> "out" </> "dapp.sol.json") json
  readBuildOutput root DappTools
 compile CombinedJSON _root _src = error "unsupported"
 compile foundryType root src = do
- createDirectory (root </> "src")
- writeFile (root </> "src" </> "unit-tests.t.sol") =<< readFile =<< Paths.getDataFileName src
- initLib (root </> "lib" </> "ds-test") ("test" </> "contracts" </> "lib" </> "test.sol") "test.sol"
- initLib (root </> "lib" </> "tokens") ("test" </> "contracts" </> "lib" </> "erc20.sol") "erc20.sol"
+ liftIO $ createDirectory (root </> "src")
+ liftIO $ writeFile (root </> "src" </> "unit-tests.t.sol") =<< readFile =<< Paths.getDataFileName src
+ liftIO $ initLib (root </> "lib" </> "ds-test") ("test" </> "contracts" </> "lib" </> "test.sol") "test.sol"
+ liftIO $ initLib (root </> "lib" </> "tokens") ("test" </> "contracts" </> "lib" </> "erc20.sol") "erc20.sol"
  case foundryType of
- FoundryStdLib -> initStdForgeDir (root </> "lib" </> "forge-std")
+ FoundryStdLib -> liftIO $ initStdForgeDir (root </> "lib" </> "forge-std")
  Foundry -> pure ()
- r@(res,_,_) <- readProcessWithExitCode "forge" ["build", "--root", root] ""
+ r@(res,_,_) <- liftIO $ readProcessWithExitCode "forge" ["build", "--ast", "--root", root] ""
  case res of
  ExitFailure _ -> pure . Left $ "compilation failed: " <> show r
  ExitSuccess -> readBuildOutput root Foundry

test/test.hs

@@ -70,6 +70,7 @@ import EVM.Test.Utils
 import EVM.Traversals
 import EVM.Types hiding (Env)
 import EVM.Effects
+import EVM.UnitTest (writeTrace)
 
 testEnv :: Env
 testEnv = Env { config = defaultConfig {