diff --git a/flake.nix b/flake.nix index c480d7021..75b3b7472 100644 --- a/flake.nix +++ b/flake.nix @@ -38,7 +38,7 @@ })) (haskell.lib.compose.addTestToolDepends [ solc z3 cvc5 ]) (haskell.lib.compose.appendConfigureFlags ( - [ "--ghc-option=-O2" ] + [ "--ghc-option=-O2" "-fci" ] ++ lib.optionals stdenv.isLinux [ "--enable-executable-static" "--extra-lib-dirs=${gmp.override { withStatic = true; }}/lib" diff --git a/hevm.cabal b/hevm.cabal index 9e259a6bd..f274d444e 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -40,11 +40,18 @@ extra-source-files: test/contracts/fail/dsProveFail.sol test/contracts/fail/invariantFail.sol +flag ci + description: Sets flags for compilation in CI + default: False + manual: True + source-repository head type: git location: https://github.com/ethereum/hevm.git common shared + if flag(ci) + ghc-options: -Werror default-language: Haskell2010 default-extensions: @@ -287,6 +294,8 @@ common test-common test-base build-depends: test-utils + other-modules: + EVM.TestUtils if os(darwin) extra-libraries: c++ -- https://gitlab.haskell.org/ghc/ghc/-/issues/11829 diff --git a/src/EVM/Dapp.hs b/src/EVM/Dapp.hs index 79fef6a4a..9e37b38ab 100644 --- a/src/EVM/Dapp.hs +++ b/src/EVM/Dapp.hs @@ -68,7 +68,7 @@ dappInfo root solcByName sources = let solcs = Map.elems solcByName astIds = astIdMap $ snd <$> toList (view sourceAsts sources) - immutables = filter ((/=) mempty . _immutableReferences) solcs + immutables = filter ((/=) mempty . (view immutableReferences)) solcs in DappInfo { _dappRoot = root diff --git a/src/EVM/Flatten.hs b/src/EVM/Flatten.hs index 3d49ea289..2aedd2290 100644 --- a/src/EVM/Flatten.hs +++ b/src/EVM/Flatten.hs @@ -1,3 +1,5 @@ +{-# Language TupleSections #-} + module EVM.Flatten (flatten) where -- This module concatenates all the imported dependencies @@ -33,12 +35,12 @@ import qualified Data.Graph.Inductive.Query.DFS as Fgl import Data.SemVer (SemVerRange, parseSemVerRange) import qualified Data.SemVer as SemVer -import Control.Monad (forM) +import Control.Monad (forM, (>=>)) import Data.ByteString (ByteString) import Data.Foldable (foldl', toList) import Data.List (sort, nub, (\\)) import Data.Map (Map, (!), (!?)) -import Data.Maybe (mapMaybe, isJust, catMaybes, fromMaybe) +import Data.Maybe (mapMaybe, isJust, fromMaybe) import Data.Text (Text, unpack, pack, intercalate) import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Text.Read (readMaybe) @@ -210,7 +212,7 @@ flatten dapp target = do joinLicenses :: [Value] -> Text joinLicenses asts = - case nub $ mapMaybe (\ast -> getAttribute "license" ast >>= preview _String) asts of + case nub $ mapMaybe (getAttribute "license" >=> preview _String) asts of [] -> "" x -> "// SPDX-License-Identifier: " <> intercalate " AND " x @@ -248,9 +250,9 @@ maximalPragma asts = ( ps = filter (nodeIs "PragmaDirective") (universe ast) components :: [[Value]] - components = catMaybes $ - fmap - ((fmap toList) . (\x -> getAttribute "literals" x >>= preview _Array)) + components = mapMaybe + ((fmap toList) + . (getAttribute "literals" >=> preview _Array)) ps -- Simple way to combine many SemVer ranges. We don't actually @@ -400,9 +402,9 @@ prefixContractAst castr cs bso ast = prefixAstNodes + (BS.length $ fst $ BS.breakSubstring name' bs') + (BS.length name') in - fmap ((,) pos) $ id' v + fmap (pos,) $ id' v | t `elem` ["UserDefinedTypeName", "Identifier"] = - fmap ((,) end) $ refDec v + fmap (end,) $ refDec v | otherwise = error $ "internal error: not a contract reference: " ++ show t @@ -450,15 +452,16 @@ repeated :: Eq a => [a] -> [a] repeated = fmap fst $ foldl' f ([], []) where f (acc, seen) x = - ( if (x `elem` seen) && (not $ x `elem` acc) + ( if (x `elem` seen) && (x `notElem` acc) then x : acc else acc , x : seen ) indexed :: [(Integer, Text)] -> [(Integer, Text)] -indexed = fst . foldl' f ([], Map.empty) -- (zip (fmap snd xs) $ replicate (length xs) 0) xs +indexed = fst . foldl' f ([], (Map.empty :: Map Text Integer)) where + f :: (Show v, Num v, Ord k) => ([(a, Text)], Map k v) -> (a, k) -> ([(a, Text)], Map k v) f (acc, seen) (id', n) = let count = (fromMaybe 0 $ seen !? n) + 1 diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index cadb206fe..c6778a2b9 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -25,7 +25,6 @@ import Language.SMT2.Syntax (SpecConstant(..), GeneralRes(..), Term(..), QualIde import Data.Word import Numeric (readHex) import Data.ByteString (ByteString) -import Data.Maybe (fromMaybe) import qualified Data.ByteString as BS import qualified Data.List as List @@ -785,10 +784,10 @@ parseFrameCtx name = case TS.unpack name of t -> error $ "Internal Error: cannot parse " <> t <> " into an Expr" getVars :: (TS.Text -> Expr EWord) -> SolverInstance -> [TS.Text] -> IO (Map (Expr EWord) W256) -getVars parseFn inst names = Map.mapKeys parseFn <$> foldM getVar mempty names +getVars parseFn inst names = Map.mapKeys parseFn <$> foldM getOne mempty names where - getVar :: Map TS.Text W256 -> TS.Text -> IO (Map TS.Text W256) - getVar acc name = do + getOne :: Map TS.Text W256 -> TS.Text -> IO (Map TS.Text W256) + getOne acc name = do raw <- getValue inst (T.fromStrict name) let parsed = case parseCommentFreeFileMsg getValueRes (T.toStrict raw) of diff --git a/src/EVM/Solidity.hs b/src/EVM/Solidity.hs index afdc6aed3..adc449592 100644 --- a/src/EVM/Solidity.hs +++ b/src/EVM/Solidity.hs @@ -47,6 +47,7 @@ module EVM.Solidity , sourceFiles , sourceLines , sourceAsts + , immutableReferences , stripBytecodeMetadata , stripBytecodeMetadataSym , signature diff --git a/src/EVM/SymExec.hs b/src/EVM/SymExec.hs index defeac8c9..766b04eea 100644 --- a/src/EVM/SymExec.hs +++ b/src/EVM/SymExec.hs @@ -528,9 +528,11 @@ equivalenceCheck solvers bytecodeA bytecodeB opts signature' = do (Revert _ a, Revert _ b) -> if a==b then PBool False else a ./= b (Revert _ _, _) -> PBool True (_, Revert _ _) -> PBool True + (Failure _ erra, Failure _ errb) -> if erra==errb then PBool False else PBool True + (GVar _, _) -> error "Expressions cannot contain global vars" + (_ , GVar _) -> error "Expressions cannot contain global vars" (Failure _ (TmpErr s), _) -> error $ "Unhandled error: " <> s (_, Failure _ (TmpErr s)) -> error $ "Unhandled error: " <> s - (Failure _ erra, Failure _ errb) -> if erra==errb then PBool False else PBool True (ITE _ _ _, _ ) -> error "Expressions must be flattened" (_, ITE _ _ _) -> error "Expressions must be flattened" diff --git a/src/EVM/Transaction.hs b/src/EVM/Transaction.hs index 0fe179b24..550706f61 100644 --- a/src/EVM/Transaction.hs +++ b/src/EVM/Transaction.hs @@ -163,7 +163,7 @@ instance FromJSON Transaction where toAddr <- addrFieldMaybe val "to" v <- wordField val "v" value <- wordField val "value" - txType <- fmap read <$> (val JSON..:? "type") + txType <- fmap (read :: String -> Int) <$> (val JSON..:? "type") case txType of Just 0x00 -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] Nothing Nothing Just 0x01 -> do