@@ -6,7 +6,6 @@ module EVM.SymExec where
66
77import Prelude hiding (Foldable (.. ))
88
9- import Control.Arrow ((>>>) )
109import Control.Concurrent (forkIO , killThread )
1110import Control.Concurrent.Async ( mapConcurrently )
1211import Control.Concurrent.Chan (Chan , newChan , writeChan , readChan )
@@ -16,14 +15,14 @@ import Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar, readTVar, write
1615import Control.Concurrent.STM.TMVar (TMVar , putTMVar , takeTMVar , newEmptyTMVarIO )
1716import Control.Monad (when , forM_ , forM , forever )
1817import Control.Monad.Loops (whileM )
19- import Control.Monad.IO.Unlift
18+ import Control.Monad.IO.Unlift ( MonadUnliftIO , toIO , withRunInIO )
2019import Control.Monad.Operational qualified as Operational
2120import Control.Monad.ST (RealWorld , stToIO , ST )
22- import Control.Monad.State.Strict
21+ import Control.Monad.State.Strict ( liftIO , runStateT )
2322import Data.ByteString (ByteString )
2423import Data.ByteString qualified as BS
2524import Data.DoubleWord (Word256 )
26- import Data.Foldable (Foldable ( .. ) )
25+ import Data.Foldable (length , foldl' , foldr )
2726import Data.List (sortBy , sort )
2827import Data.List.NonEmpty qualified as NE
2928import Data.Maybe (fromMaybe , listToMaybe , mapMaybe , catMaybes )
@@ -34,38 +33,36 @@ import Data.Set (Set)
3433import Data.Set qualified as Set
3534import Data.Text (Text )
3635import Data.Text qualified as T
36+ import Data.Text.Encoding (encodeUtf8 )
3737import Data.Text.IO qualified as T
3838import Data.Tree.Zipper qualified as Zipper
3939import Data.Tuple (swap )
4040import Data.Vector qualified as V
4141import Data.Vector.Storable qualified as VS
4242import Data.Vector.Storable.ByteString (vectorToByteString )
43- import GHC.Conc (numCapabilities )
44- import GHC.Natural
43+ import GHC.Conc (numCapabilities , getNumProcessors )
44+ import GHC.Generics (Generic )
45+ import GHC.Num.Natural (Natural )
46+ import Optics.Core
47+ import Options.Generic (ParseField , ParseFields , ParseRecord )
48+ import Text.Printf (printf )
49+ import Witch (into , unsafeInto )
4550
4651import EVM (makeVm , abstractContract , initialContract , getCodeLocation , isValidJumpDest )
47- import EVM.Exec
52+ import EVM.Exec ( exec )
4853import EVM.Fetch qualified as Fetch
4954import EVM.ABI
5055import EVM.Effects
5156import EVM.Expr qualified as Expr
5257import EVM.FeeSchedule (feeSchedule )
5358import EVM.Format (formatExpr , formatPartial , formatPartialDetailed , showVal , indent , formatBinary , formatProp , formatState , formatError )
5459import EVM.SMT qualified as SMT
55- import EVM.Solvers
60+ import EVM.Solvers ( SolverGroup , checkSatWithProps )
5661import EVM.Stepper (Stepper )
5762import EVM.Stepper qualified as Stepper
58- import EVM.Traversals
63+ import EVM.Traversals ( mapExpr , mapExprM , foldTerm )
5964import EVM.Types hiding (Comp )
6065import EVM.Types qualified
61- import EVM.Expr (maybeConcStoreSimp )
62- import GHC.Conc (getNumProcessors )
63- import GHC.Generics (Generic )
64- import Optics.Core
65- import Options.Generic (ParseField , ParseFields , ParseRecord )
66- import Text.Printf (printf )
67- import Witch (into , unsafeInto )
68- import Data.Text.Encoding (encodeUtf8 )
6966import EVM.Solidity (WarningData (.. ))
7067
7168data LoopHeuristic
@@ -870,7 +867,7 @@ verifyInputsWithHandler solvers opts fetcher preState post cexHandler = do
870867expandCex :: VM Symbolic -> SMTCex -> SMTCex
871868expandCex prestate c = c { store = Map. union c. store concretePreStore }
872869 where
873- concretePreStore = Map. mapMaybe (maybeConcStoreSimp . (. storage))
870+ concretePreStore = Map. mapMaybe (Expr. maybeConcStoreSimp . (. storage))
874871 . Map. filter (\ v -> Expr. containsNode isConcreteStore v. storage)
875872 $ (prestate. env. contracts)
876873 isConcreteStore = \ case
@@ -1235,7 +1232,7 @@ prettyBuf b = internalError $ "Unexpected symbolic buffer:\n" <> T.unpack (forma
12351232
12361233calldataFromCex :: App m => SMTCex -> Expr Buf -> Sig -> m (Err ByteString )
12371234calldataFromCex cex buf sig = do
1238- let sigKeccak = keccakSig $ encodeUtf8 (callSig sig)
1235+ let sigKeccak = BS. take 4 $ keccakBytes $ encodeUtf8 (callSig sig)
12391236 pure $ (sigKeccak <> ) <$> body
12401237 where
12411238 cd = defaultSymbolicValues $ subModel cex buf
@@ -1246,8 +1243,6 @@ calldataFromCex cex buf sig = do
12461243 forceConcrete :: (Expr Buf ) -> Err ByteString
12471244 forceConcrete (ConcreteBuf k) = Right k
12481245 forceConcrete _ = Left " Symbolic buffer in calldata, cannot produce concrete model"
1249- keccakSig :: ByteString -> ByteString
1250- keccakSig = keccakBytes >>> BS. take 4
12511246
12521247prettyCalldata :: SMTCex -> Expr Buf -> Text -> [AbiType ] -> Text
12531248prettyCalldata cex buf sig types = headErr errSig (T. splitOn " (" sig) <> " (" <> body <> " )" <> T. pack finalErr
0 commit comments