hevm 0.53.0 → 0.54.2

raw patch · 38 files changed

+3266/−2203 lines, 38 filesdep +extradep +splitdep +template-haskelldep −HUnitdep −MissingHdep −abstract-pardep ~QuickCheckdep ~aesondep ~asyncPVP ok

version bump matches the API change (PVP)

Dependencies added: extra, split, template-haskell, with-utf8

Dependencies removed: HUnit, MissingH, abstract-par, array, brick, deepseq, free, haskeline, monad-par, multiset, quickcheck-text, restless-git, vty, word-wrap

Dependency ranges changed: QuickCheck, aeson, async, base16, binary, containers, cryptonite, data-dword, directory, githash, here, memory, mtl, operational, optparse-generic, process, regex-tdfa, smt2-parser, spawn, stm, system-cxx-std-lib, tasty, tasty-expected-failure, tasty-hunit, tasty-quickcheck, temporary, time, transformers, unliftio-core, unordered-containers, vector, witherable

API changes (from Hackage documentation)

- EVM.Dapp: [$sel:env:DappContext] :: DappContext -> Map (Expr EAddr) Contract

- EVM.Effects: [$sel:abstRefineArith:Config] :: Config -> Bool

- EVM.Effects: [$sel:abstRefineMem:Config] :: Config -> Bool

- EVM.Effects: writeTrace :: App m => VM t RealWorld -> m ()

- EVM.Effects: writeTraceDapp :: App m => DappInfo -> VM t RealWorld -> m ()

- EVM.Expr: constFoldProp :: [Prop] -> Bool

- EVM.Expr: pattern ArraySlotWithOffset :: ByteString -> Expr EWord -> Expr EWord

- EVM.Expr: pattern Keccak64Bytes :: Expr EWord

- EVM.Expr: to512 :: W256 -> Word512

- EVM.SMT: RefinementEqs :: [Builder] -> [Prop] -> RefinementEqs

- EVM.SMT: abstractAwayProps :: Config -> [Prop] -> ([Prop], AbstState)

- EVM.SMT: data RefinementEqs

- EVM.SMT: instance GHC.Base.Monoid EVM.SMT.RefinementEqs

- EVM.SMT: instance GHC.Base.Semigroup EVM.SMT.RefinementEqs

- EVM.SMT: instance GHC.Classes.Eq EVM.SMT.RefinementEqs

- EVM.SMT: instance GHC.Show.Show EVM.SMT.RefinementEqs

- EVM.Solidity: DappTools :: ProjectType

- EVM.Solidity: FoundryStdLib :: ProjectType

- EVM.Solvers: isErr :: CheckSatResult -> Bool

- EVM.SymExec: Timeout :: c -> ProofResult a b c

- EVM.SymExec: getTimeout :: ProofResult a b c -> Maybe c

- EVM.SymExec: instance (GHC.Classes.Eq a, GHC.Classes.Eq b, GHC.Classes.Eq c) => GHC.Classes.Eq (EVM.SymExec.ProofResult a b c)

- EVM.SymExec: instance (GHC.Show.Show a, GHC.Show.Show b, GHC.Show.Show c) => GHC.Show.Show (EVM.SymExec.ProofResult a b c)

- EVM.SymExec: isTimeout :: ProofResult a b c -> Bool

- EVM.Traversals: foldContract :: forall b. Monoid b => (forall a. Expr a -> b) -> b -> Contract -> b

- EVM.Types: Traces :: Forest Trace -> Map (Expr EAddr) Contract -> Traces

- EVM.Types: [$sel:contracts:Traces] :: Traces -> Map (Expr EAddr) Contract

- EVM.Types: [$sel:overrideCaller:RuntimeConfig] :: RuntimeConfig -> Maybe (Expr EAddr)

- EVM.Types: [$sel:substate:CreationContext] :: FrameContext -> SubState

- EVM.Types: [$sel:substate:TxState] :: TxState -> SubState

- EVM.Types: [$sel:traces:Traces] :: Traces -> Forest Trace

- EVM.Types: data Traces

- EVM.Types: fromWord512 :: Word512 -> W256

- EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ EVM.Types.SubState, b GHC.Types.~ EVM.Types.SubState) => Optics.Label.LabelOptic "substate" k EVM.Types.TxState EVM.Types.TxState a b

- EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ GHC.Maybe.Maybe (EVM.Types.Expr 'EVM.Types.EAddr), b GHC.Types.~ GHC.Maybe.Maybe (EVM.Types.Expr 'EVM.Types.EAddr)) => Optics.Label.LabelOptic "overrideCaller" k EVM.Types.RuntimeConfig EVM.Types.RuntimeConfig a b

- EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.An_AffineTraversal, a GHC.Types.~ EVM.Types.SubState, b GHC.Types.~ EVM.Types.SubState) => Optics.Label.LabelOptic "subState" k EVM.Types.FrameContext EVM.Types.FrameContext a b

- EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.An_AffineTraversal, a GHC.Types.~ EVM.Types.SubState, b GHC.Types.~ EVM.Types.SubState) => Optics.Label.LabelOptic "substate" k EVM.Types.FrameContext EVM.Types.FrameContext a b

- EVM.Types: instance GHC.Base.Monoid EVM.Types.Traces

- EVM.Types: instance GHC.Base.Semigroup EVM.Types.Traces

- EVM.Types: instance GHC.Classes.Eq EVM.Types.Traces

- EVM.Types: instance GHC.Classes.Ord EVM.Types.Traces

- EVM.Types: instance GHC.Generics.Generic EVM.Types.Traces

- EVM.Types: instance GHC.Show.Show EVM.Types.Traces

- EVM.Types: toInt :: W256 -> Maybe Int

- EVM.Types: toWord512 :: W256 -> Word512

- EVM.UnitTest: checkSymFailures :: VMOps t => UnitTestOptions RealWorld -> Stepper t RealWorld (VM t RealWorld)

- EVM.UnitTest: execSymTest :: UnitTestOptions RealWorld -> ABIMethod -> (Expr Buf, [Prop]) -> Stepper Symbolic RealWorld (Expr End)

+ EVM: accessTStorage :: VMOps t => Expr EAddr -> Expr EWord -> (Expr EWord -> EVM t s ()) -> EVM t s ()

+ EVM: clearTStorages :: EVM t s ()

+ EVM: getOpName :: forall (t :: VMType) s. FrameState t s -> [Char]

+ EVM: getOpW8 :: forall (t :: VMType) s. FrameState t s -> Word8

+ EVM: setEIP4788Storage :: VMOpts t -> VM t s -> VM t s

+ EVM.ABI: instance EVM.ABI.ShowAlter EVM.ABI.AbiValue

+ EVM.ABI: showAlter :: ShowAlter a => a -> String

+ EVM.Dapp: [$sel:contracts:DappContext] :: DappContext -> Map (Expr EAddr) Contract

+ EVM.Dapp: [$sel:labels:DappContext] :: DappContext -> Map Addr Text

+ EVM.Effects: [$sel:decomposeStorage:Config] :: Config -> Bool

+ EVM.Expr: checkLHSConst :: Expr a -> Bool

+ EVM.Expr: checkLHSConstProp :: Prop -> Bool

+ EVM.Expr: isUnsat :: [Prop] -> Bool

+ EVM.Expr: lhsConstHelper :: Expr a -> Maybe ()

+ EVM.Expr: maxWord256 :: W256

+ EVM.Expr: pattern ArraySlotWithOffs :: ByteString -> Expr EWord -> Expr EWord

+ EVM.Expr: peq :: Typeable a => Expr a -> Expr a -> Prop

+ EVM.Expr: safeToDecomposeProp :: Prop -> Bool

+ EVM.Op: OpBlobBaseFee :: GenericOp a

+ EVM.Op: OpBlobhash :: GenericOp a

+ EVM.Op: OpMcopy :: GenericOp a

+ EVM.Op: OpTload :: GenericOp a

+ EVM.Op: OpTstore :: GenericOp a

+ EVM.SMT: assertSMT :: Prop -> Either String Builder

+ EVM.SMT: instance GHC.Base.Monoid EVM.SMT.SMTCex

+ EVM.SMT: instance GHC.Base.Semigroup EVM.SMT.SMTCex

+ EVM.Solvers: stripCarriageReturn :: Text -> Text

+ EVM.SymExec: Error :: d -> ProofResult a b c d

+ EVM.SymExec: Unknown :: c -> ProofResult a b c d

+ EVM.SymExec: freezeVM :: VM Symbolic RealWorld -> ST RealWorld (VM Symbolic RealWorld)

+ EVM.SymExec: getUnknown :: ProofResult a b c d -> Maybe c

+ EVM.SymExec: groupIssues :: [ProofResult a b c String] -> [(Integer, String)]

+ EVM.SymExec: instance (GHC.Classes.Eq a, GHC.Classes.Eq b, GHC.Classes.Eq c, GHC.Classes.Eq d) => GHC.Classes.Eq (EVM.SymExec.ProofResult a b c d)

+ EVM.SymExec: instance (GHC.Show.Show a, GHC.Show.Show b, GHC.Show.Show c, GHC.Show.Show d) => GHC.Show.Show (EVM.SymExec.ProofResult a b c d)

+ EVM.SymExec: isError :: ProofResult a b c d -> Bool

+ EVM.SymExec: isUnknown :: ProofResult a b c d -> Bool

+ EVM.Traversals: mapExprM_ :: Monad m => (forall a. Expr a -> m ()) -> Expr b -> m ()

+ EVM.Traversals: mapPropM' :: forall m. Monad m => (Prop -> m Prop) -> Prop -> m Prop

+ EVM.Traversals: mapPropM_ :: Monad m => (forall a. Expr a -> m ()) -> Prop -> m ()

+ EVM.Types: OpBlobBaseFee :: GenericOp a

+ EVM.Types: OpBlobhash :: GenericOp a

+ EVM.Types: OpMcopy :: GenericOp a

+ EVM.Types: OpTload :: GenericOp a

+ EVM.Types: OpTstore :: GenericOp a

+ EVM.Types: TraceContext :: Forest Trace -> Map (Expr EAddr) Contract -> Map Addr Text -> TraceContext

+ EVM.Types: [$sel:beaconRoot:VMOpts] :: VMOpts (t :: VMType) -> W256

+ EVM.Types: [$sel:contracts:TraceContext] :: TraceContext -> Map (Expr EAddr) Contract

+ EVM.Types: [$sel:createdContracts:SubState] :: SubState -> Set (Expr EAddr)

+ EVM.Types: [$sel:freshAddresses:VMOpts] :: VMOpts (t :: VMType) -> Int

+ EVM.Types: [$sel:labels:TraceContext] :: TraceContext -> Map Addr Text

+ EVM.Types: [$sel:labels:VM] :: VM (t :: VMType) s -> Map Addr Text

+ EVM.Types: [$sel:opcode:UnexpectedSymbolicArg] :: PartialExec -> String

+ EVM.Types: [$sel:osEnv:VM] :: VM (t :: VMType) s -> Map String String

+ EVM.Types: [$sel:overrideCaller:FrameState] :: FrameState (t :: VMType) s -> Maybe (Expr EAddr)

+ EVM.Types: [$sel:resetCaller:FrameState] :: FrameState (t :: VMType) s -> Bool

+ EVM.Types: [$sel:subState:TxState] :: TxState -> SubState

+ EVM.Types: [$sel:tStorage:Contract] :: Contract -> Expr Storage

+ EVM.Types: [$sel:traces:TraceContext] :: TraceContext -> Forest Trace

+ EVM.Types: [PleaseReadEnv] :: String -> (String -> EVM t s ()) -> Query t s

+ EVM.Types: data TraceContext

+ EVM.Types: evmErrToString :: EvmError -> String

+ EVM.Types: getError :: Err a -> String

+ EVM.Types: getNonError :: Err a -> a

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ Data.Map.Internal.Map EVM.Types.Addr Data.Text.Internal.Text, b GHC.Types.~ Data.Map.Internal.Map EVM.Types.Addr Data.Text.Internal.Text) => Optics.Label.LabelOptic "labels" k (EVM.Types.VM t s) (EVM.Types.VM t s) a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ Data.Map.Internal.Map GHC.Base.String GHC.Base.String, b GHC.Types.~ Data.Map.Internal.Map GHC.Base.String GHC.Base.String) => Optics.Label.LabelOptic "osEnv" k (EVM.Types.VM t s) (EVM.Types.VM t s) a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ Data.Set.Internal.Set (EVM.Types.Expr 'EVM.Types.EAddr), b GHC.Types.~ Data.Set.Internal.Set (EVM.Types.Expr 'EVM.Types.EAddr)) => Optics.Label.LabelOptic "createdContracts" k EVM.Types.SubState EVM.Types.SubState a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ EVM.Types.Expr 'EVM.Types.Storage, b GHC.Types.~ EVM.Types.Expr 'EVM.Types.Storage) => Optics.Label.LabelOptic "tStorage" k EVM.Types.Contract EVM.Types.Contract a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ EVM.Types.SubState, b GHC.Types.~ EVM.Types.SubState) => Optics.Label.LabelOptic "subState" k EVM.Types.FrameContext EVM.Types.FrameContext a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ EVM.Types.W256, b GHC.Types.~ EVM.Types.W256) => Optics.Label.LabelOptic "beaconRoot" k (EVM.Types.VMOpts t) (EVM.Types.VMOpts t) a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ GHC.Maybe.Maybe (EVM.Types.Expr 'EVM.Types.EAddr), b GHC.Types.~ GHC.Maybe.Maybe (EVM.Types.Expr 'EVM.Types.EAddr)) => Optics.Label.LabelOptic "overrideCaller" k (EVM.Types.FrameState t s) (EVM.Types.FrameState t s) a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ GHC.Types.Bool, b GHC.Types.~ GHC.Types.Bool) => Optics.Label.LabelOptic "resetCaller" k (EVM.Types.FrameState t s) (EVM.Types.FrameState t s) a b

+ EVM.Types: instance (k GHC.Types.~ Optics.Internal.Optic.Types.A_Lens, a GHC.Types.~ GHC.Types.Int, b GHC.Types.~ GHC.Types.Int) => Optics.Label.LabelOptic "freshAddresses" k (EVM.Types.VMOpts t) (EVM.Types.VMOpts t) a b

+ EVM.Types: instance GHC.Base.Monoid EVM.Types.TraceContext

+ EVM.Types: instance GHC.Base.Semigroup EVM.Types.TraceContext

+ EVM.Types: instance GHC.Classes.Eq EVM.Types.TraceContext

+ EVM.Types: instance GHC.Classes.Ord EVM.Types.TraceContext

+ EVM.Types: instance GHC.Generics.Generic EVM.Types.TraceContext

+ EVM.Types: instance GHC.Show.Show EVM.Types.TraceContext

+ EVM.Types: instance Witch.From.From EVM.Types.W256 EVM.Types.Word512

+ EVM.Types: type Err a = Either String a

+ EVM.UnitTest: [$sel:checkFailBit:UnitTestOptions] :: UnitTestOptions s -> Bool

+ EVM.UnitTest: writeTrace :: App m => VM t RealWorld -> m ()

+ EVM.UnitTest: writeTraceDapp :: App m => DappInfo -> VM t RealWorld -> m ()

- EVM: cheat :: (?op :: Word8, VMOps t) => (Expr EWord, Expr EWord) -> (Expr EWord, Expr EWord) -> EVM t s ()

+ EVM: cheat :: (?op :: Word8, VMOps t) => Gas t -> (Expr EWord, Expr EWord) -> (Expr EWord, Expr EWord) -> [Expr EWord] -> EVM t s ()

- EVM: traceContext :: Expr End -> Map (Expr EAddr) Contract

+ EVM: traceContext :: Expr End -> TraceContext

- EVM: type CheatAction t s = Expr EWord -> Expr EWord -> Expr Buf -> EVM t s ()

+ EVM: type CheatAction t s = Expr Buf -> EVM t s ()

- EVM.Dapp: DappContext :: DappInfo -> Map (Expr EAddr) Contract -> DappContext

+ EVM.Dapp: DappContext :: DappInfo -> Map (Expr EAddr) Contract -> Map Addr Text -> DappContext

- EVM.Effects: Config :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Integer -> Bool -> Config

+ EVM.Effects: Config :: Bool -> Bool -> Bool -> Bool -> Bool -> Integer -> Bool -> Bool -> Config

- EVM.Expr: safeToDecompose :: Expr a -> Bool

+ EVM.Expr: safeToDecompose :: Expr a -> Maybe ()

- EVM.Format: hexByteString :: String -> ByteString -> ByteString

+ EVM.Format: hexByteString :: ByteString -> Maybe ByteString

- EVM.SMT: SMT2 :: [Builder] -> RefinementEqs -> CexVars -> [Prop] -> SMT2

+ EVM.SMT: SMT2 :: [Builder] -> CexVars -> [Prop] -> SMT2

- EVM.SMT: assertProps :: Config -> [Prop] -> SMT2

+ EVM.SMT: assertProps :: Config -> [Prop] -> Err SMT2

- EVM.SMT: assertPropsNoSimp :: Config -> [Prop] -> SMT2

+ EVM.SMT: assertPropsNoSimp :: [Prop] -> Err SMT2

- EVM.SMT: concatBytes :: [Expr Byte] -> Builder

+ EVM.SMT: concatBytes :: [Expr Byte] -> Err Builder

- EVM.SMT: copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Builder

+ EVM.SMT: copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder

- EVM.SMT: declareBlockContext :: [(Builder, [Prop])] -> SMT2

+ EVM.SMT: declareBlockContext :: [(Builder, [Prop])] -> Err SMT2

- EVM.SMT: declareFrameContext :: [(Builder, [Prop])] -> SMT2

+ EVM.SMT: declareFrameContext :: [(Builder, [Prop])] -> Err SMT2

- EVM.SMT: declareIntermediates :: BufEnv -> StoreEnv -> SMT2

+ EVM.SMT: declareIntermediates :: BufEnv -> StoreEnv -> Err SMT2

- EVM.SMT: encodeConcreteStore :: Map W256 W256 -> Builder

+ EVM.SMT: encodeConcreteStore :: Map W256 W256 -> Err Builder

- EVM.SMT: expandExp :: Expr EWord -> W256 -> Builder

+ EVM.SMT: expandExp :: Expr EWord -> W256 -> Err Builder

- EVM.SMT: exprToSMT :: Expr a -> Builder

+ EVM.SMT: exprToSMT :: Expr a -> Err Builder

- EVM.SMT: propToSMT :: Prop -> Builder

+ EVM.SMT: propToSMT :: Prop -> Err Builder

- EVM.SMT: writeBytes :: ByteString -> Expr Buf -> Builder

+ EVM.SMT: writeBytes :: ByteString -> Expr Buf -> Err Builder

- EVM.Solidity: readBuildOutput :: FilePath -> ProjectType -> IO (Either String BuildOutput)

+ EVM.Solidity: readBuildOutput :: App m => FilePath -> ProjectType -> m (Either String BuildOutput)

- EVM.Solidity: readSolc :: ProjectType -> FilePath -> FilePath -> IO (Either String BuildOutput)

+ EVM.Solidity: readSolc :: App m => ProjectType -> FilePath -> FilePath -> m (Either String BuildOutput)

- EVM.Solidity: solcRuntime :: MonadUnliftIO m => Text -> Text -> m (Maybe ByteString)

+ EVM.Solidity: solcRuntime :: App m => Text -> Text -> m (Maybe ByteString)

- EVM.Solvers: Error :: Text -> CheckSatResult

+ EVM.Solvers: Error :: String -> CheckSatResult

- EVM.Solvers: Unknown :: CheckSatResult

+ EVM.Solvers: Unknown :: String -> CheckSatResult

- EVM.Solvers: checkSat :: SolverGroup -> SMT2 -> IO CheckSatResult

+ EVM.Solvers: checkSat :: SolverGroup -> Err SMT2 -> IO CheckSatResult

- EVM.Solvers: solverArgs :: Solver -> Maybe Natural -> [Text]

+ EVM.Solvers: solverArgs :: Solver -> Natural -> Maybe Natural -> [Text]

- EVM.Solvers: spawnSolver :: Solver -> Maybe Natural -> IO SolverInstance

+ EVM.Solvers: spawnSolver :: Solver -> Natural -> Maybe Natural -> IO SolverInstance

- EVM.Solvers: withSolvers :: App m => Solver -> Natural -> Maybe Natural -> (SolverGroup -> m a) -> m a

+ EVM.Solvers: withSolvers :: App m => Solver -> Natural -> Natural -> Maybe Natural -> (SolverGroup -> m a) -> m a

- EVM.Solvers: writeSMT2File :: SMT2 -> Int -> String -> IO ()

+ EVM.Solvers: writeSMT2File :: SMT2 -> Int -> IO ()

- EVM.SymExec: Cex :: b -> ProofResult a b c

+ EVM.SymExec: Cex :: b -> ProofResult a b c d

- EVM.SymExec: Qed :: a -> ProofResult a b c

+ EVM.SymExec: Qed :: a -> ProofResult a b c d

- EVM.SymExec: data ProofResult a b c

+ EVM.SymExec: data ProofResult a b c d

- EVM.SymExec: getCex :: ProofResult a b c -> Maybe b

+ EVM.SymExec: getCex :: ProofResult a b c d -> Maybe b

- EVM.SymExec: isCex :: ProofResult a b c -> Bool

+ EVM.SymExec: isCex :: ProofResult a b c d -> Bool

- EVM.SymExec: isQed :: ProofResult a b c -> Bool

+ EVM.SymExec: isQed :: ProofResult a b c d -> Bool

- EVM.SymExec: type EquivResult = ProofResult () (SMTCex) ()

+ EVM.SymExec: type EquivResult = ProofResult () (SMTCex) () String

- EVM.SymExec: type VerifyResult = ProofResult () (Expr End, SMTCex) (Expr End)

+ EVM.SymExec: type VerifyResult = ProofResult () (Expr End, SMTCex) (Expr End) String

- EVM.Types: BadCheatCode :: FunctionSelector -> EvmError

+ EVM.Types: BadCheatCode :: String -> FunctionSelector -> EvmError

- EVM.Types: Contract :: ContractCode -> Expr Storage -> Expr Storage -> Expr EWord -> Maybe W64 -> Expr EWord -> Vector Int -> Vector (Int, Op) -> Bool -> Contract

+ EVM.Types: Contract :: ContractCode -> Expr Storage -> Expr Storage -> Expr Storage -> Expr EWord -> Maybe W64 -> Expr EWord -> Vector Int -> Vector (Int, Op) -> Bool -> Contract

- EVM.Types: FrameState :: Expr EAddr -> Expr EAddr -> ContractCode -> {-# UNPACK #-} !Int -> [Expr EWord] -> Memory s -> Word64 -> Expr Buf -> Expr EWord -> Expr EAddr -> !Gas t -> Expr Buf -> Bool -> FrameState (t :: VMType) s

+ EVM.Types: FrameState :: Expr EAddr -> Expr EAddr -> ContractCode -> {-# UNPACK #-} !Int -> [Expr EWord] -> Memory s -> Word64 -> Expr Buf -> Expr EWord -> Expr EAddr -> !Gas t -> Expr Buf -> Bool -> Maybe (Expr EAddr) -> Bool -> FrameState (t :: VMType) s

- EVM.Types: RuntimeConfig :: Bool -> Maybe (Expr EAddr) -> BaseState -> RuntimeConfig

+ EVM.Types: RuntimeConfig :: Bool -> BaseState -> RuntimeConfig

- EVM.Types: SubState :: [Expr EAddr] -> [Expr EAddr] -> Set (Expr EAddr) -> Set (Expr EAddr, W256) -> [(Expr EAddr, Word64)] -> SubState

+ EVM.Types: SubState :: [Expr EAddr] -> [Expr EAddr] -> Set (Expr EAddr) -> Set (Expr EAddr, W256) -> [(Expr EAddr, Word64)] -> Set (Expr EAddr) -> SubState

- EVM.Types: UnexpectedSymbolicArg :: Int -> String -> [SomeExpr] -> PartialExec

+ EVM.Types: UnexpectedSymbolicArg :: Int -> String -> String -> [SomeExpr] -> PartialExec

- EVM.Types: VM :: Maybe (VMResult t s) -> FrameState t s -> [Frame t s] -> Env -> Block -> TxState -> [Expr Log] -> TreePos Empty Trace -> Cache -> !Gas t -> Map CodeLocation (Int, [Expr EWord]) -> [Prop] -> RuntimeConfig -> Seq ForkState -> Int -> VM (t :: VMType) s

+ EVM.Types: VM :: Maybe (VMResult t s) -> FrameState t s -> [Frame t s] -> Env -> Block -> TxState -> [Expr Log] -> TreePos Empty Trace -> Cache -> !Gas t -> Map CodeLocation (Int, [Expr EWord]) -> [Prop] -> RuntimeConfig -> Seq ForkState -> Int -> Map Addr Text -> Map String String -> VM (t :: VMType) s

- EVM.Types: VMOpts :: Contract -> [(Expr EAddr, Contract)] -> (Expr Buf, [Prop]) -> BaseState -> Expr EWord -> W256 -> Expr EAddr -> Expr EAddr -> Expr EAddr -> Gas t -> Word64 -> W256 -> Expr EWord -> Expr EAddr -> W256 -> W256 -> Word64 -> W256 -> W256 -> FeeSchedule Word64 -> W256 -> Bool -> Map (Expr EAddr) [W256] -> Bool -> VMOpts (t :: VMType)

+ EVM.Types: VMOpts :: Contract -> [(Expr EAddr, Contract)] -> (Expr Buf, [Prop]) -> BaseState -> Expr EWord -> W256 -> Expr EAddr -> Expr EAddr -> Expr EAddr -> Gas t -> Word64 -> W256 -> Expr EWord -> Expr EAddr -> W256 -> W256 -> Word64 -> W256 -> W256 -> FeeSchedule Word64 -> W256 -> Bool -> Map (Expr EAddr) [W256] -> Bool -> Int -> W256 -> VMOpts (t :: VMType)

- EVM.Types: [C] :: ContractCode -> Expr Storage -> Expr EWord -> Maybe W64 -> Expr EContract

+ EVM.Types: [C] :: ContractCode -> Expr Storage -> Expr Storage -> Expr EWord -> Maybe W64 -> Expr EContract

- EVM.Types: [Failure] :: [Prop] -> Traces -> EvmError -> Expr End

+ EVM.Types: [Failure] :: [Prop] -> TraceContext -> EvmError -> Expr End

- EVM.Types: [Partial] :: [Prop] -> Traces -> PartialExec -> Expr End

+ EVM.Types: [Partial] :: [Prop] -> TraceContext -> PartialExec -> Expr End

- EVM.Types: [PleaseDoFFI] :: [String] -> (ByteString -> EVM t s ()) -> Query t s

+ EVM.Types: [PleaseDoFFI] :: [String] -> Map String String -> (ByteString -> EVM t s ()) -> Query t s

- EVM.Types: [Success] :: [Prop] -> Traces -> Expr Buf -> Map (Expr EAddr) (Expr EContract) -> Expr End

+ EVM.Types: [Success] :: [Prop] -> TraceContext -> Expr Buf -> Map (Expr EAddr) (Expr EContract) -> Expr End

- EVM.UnitTest: UnitTestOptions :: RpcInfo -> SolverGroup -> Maybe Int -> Maybe Integer -> Integer -> Maybe Natural -> Maybe Text -> Text -> DappInfo -> TestVMParams -> Bool -> UnitTestOptions s

+ EVM.UnitTest: UnitTestOptions :: RpcInfo -> SolverGroup -> Maybe Int -> Maybe Integer -> Integer -> Maybe Natural -> Maybe Text -> Text -> DappInfo -> TestVMParams -> Bool -> Bool -> UnitTestOptions s

- EVM.UnitTest: allBranchRev :: Text -> Text

+ EVM.UnitTest: allBranchRev :: Text

- EVM.UnitTest: symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m (Text, Either Text Text)

+ EVM.UnitTest: symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m Bool

Files

CHANGELOG.md +86/−3
bench/bench.hs +7/−6
cli/cli.hs +177/−107
ethjet/blake2.c +65/−0
ethjet/blake2.cc +0/−65
ethjet/ethjet-ff.cc +1/−8
hevm.cabal +57/−104
src/EVM.hs +582/−275
src/EVM/ABI.hs +39/−19
src/EVM/Assembler.hs +5/−2
src/EVM/CSE.hs +0/−2
src/EVM/CheatsTH.hs +72/−0
src/EVM/Concrete.hs +0/−2
src/EVM/Dapp.hs +3/−4
src/EVM/Effects.hs +9/−37
src/EVM/Exec.hs +2/−0
src/EVM/Expr.hs +217/−129
src/EVM/Fetch.hs +17/−13
src/EVM/Format.hs +88/−74
src/EVM/Fuzz.hs +9/−10
src/EVM/Keccak.hs +20/−33
src/EVM/Op.hs +16/−3
src/EVM/Precompiled.hs +3/−3
src/EVM/SMT.hs +339/−314
src/EVM/Solidity.hs +35/−37
src/EVM/Solvers.hs +59/−65
src/EVM/Stepper.hs +3/−4
src/EVM/SymExec.hs +124/−74
src/EVM/Transaction.hs +88/−79
src/EVM/Traversals.hs +53/−13
src/EVM/Types.hs +83/−45
src/EVM/UnitTest.hs +90/−93
test/BlockchainTests.hs +1/−1
test/EVM/Test/BlockchainTests.hs +190/−146
test/EVM/Test/Tracing.hs +65/−63
test/EVM/Test/Utils.hs +41/−93
test/rpc.hs +4/−2
test/test.hs +616/−275

CHANGELOG.md view

@@ -1,5 +1,3 @@-## [0.53.0] - 2024-02-23- # Changelog  All notable changes to this project will be documented in this file.@@ -7,8 +5,93 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.54.2] - 2024-12-12++## Fixed+- Fixed GitHub release action to upload release binaries++## [0.54.1] - 2024-12-12++## Fixed+- Fixed GitHub release action to create release binaries++## [0.54.0] - 2024-12-10+ ## Changed+- Improved printing of results. Should be more intuitive to understand what hevm found.+- More complete and precise array/mapping slot rewrite, along with a copySlice improvement+- Use a let expression in copySlice to decrease expression size+- The `--debug` flag now dumps the internal expressions as well+- hevm now uses the forge-std library's way of detecting failures, i.e. through+  reverting with a specific error code unless --assertion-type DSTest is passed+- Default max iterations is 5 now. `--max-iters -1` now signals no bound. This change is to match other+  symbolic execution frameworks' default bound and to not go into an infinite loop by default when+  there could be other, interesting and reachable bugs in the code+- Update to GHC version 9.6.5+- Abstraction-refinement is no longer an option, it was never really useful and not well-tested +## Added+- More POr and PAnd rules+- Array/Map slot decomposition can be turned off via a flag+- More PEq, PLEq, and PLT rules+- New `label` cheatcode.+- Updated Bitwuzla to newer version+- New cheatcodes `startPrank()` & `stopPrank()`+- ARM64 and x86_64 Mac along with Linux x86_64 static binaries for releases+- Tutorial for symbolic execution+- 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 RPC fetching of contract data+- Symbolic ABI encoding for tuples, fuzzer for encoder+- Printing `Addrs` when running `symbolic` for counterexamples and reachable end states+- Improved symbolic execution tutorial+- More Mod, SMod, Div, and SDiv simplification rules+- Add `freshAddresses` field in `VMOpts` so that initial fresh address can be given as input+- Add documentation about limitations and workarounds+- More verbose error messages in case of symbolic arguments to opcode+- Tests to enforce that in Expr and Prop, constants are on the LHS whenever possible+- Support for MCOPY and TSTORE/TLOAD, i.e. EIP 5656 + 1153 + 4788+- All fuzz tests now run twice, once with expected SAT and once with expected UNSAT to check+  against incorrectly trivial UNSAT queries+- Allow --num-solvers option for equivalence checking, use num cores by default+- Preliminary support for multi-threaded Z3+- Skip over SMT generation issues due to e.g. CopySlice with symbolic arguments, and return+  partial results instead of erroring out+- Fix interpreter's MCOPY handling so that it doesn't error out on symbolic arguments+- More desciptive errors in case of a cheatcode issue+- Better and more pretty debug messages+- Many env* cheatcodes are now supported++## Fixed+- `vm.prank` is now respected during calls to create+- `concat` is a 2-ary, not an n-ary function in SMT2LIB, declare-const does not exist in QF_AUFBV, replacing+   with declare-fun+- CVC5 needs `--incremental` flag to work properly in abstraction-refinement mode+- cli.hs now uses with-utf8 so no release binary will have locale issues anymore+- Took ideas for simplification rules from "Super-optimization of Smart Contracts" paper by Albert et al.+- Printing panic uint256 as hex, not as int+- Decomposition does not take place when entire states are compared, as that would necessitate+  a different approach.+- `initial-storage` option of `hevm symbolic` is respected+- `caller` option of `hevm symbolic` is now respected+- Thanks to the new simplification rules, we can now enable more conformance tests+- Multi-threaded running of Tracing.hs was not possible due to IO race. Fixed.+- Fixed multi-threading bug in symbolic interpretation+- Fixed simplification of concrete CopySlice with destination offset beyond destination size+- Fixed a bug in our SMT encoding of reading multiple consecutive bytes from concrete index+- Fixed bug in SMT encoding that caused empty and all-zero byte arrays to be considered equal+  and hence lead to false negatives through trivially UNSAT SMT expressions+- Respect --smt-timeout in equivalence checking+- Fixed the handling of returndata with an abstract size during transaction finalization+- Error handling for user-facing cli commands is much improved+- Fixed call signature generation for test cases+- Fixing prank so it doesn't override the sender address on lower call frames++## [0.53.0] - 2024-02-23++## Changed+ - Minimum distance requirements are now asserted for Keccak function calls. They assert that it's hard to generate two Keccak's that are less than 256 afar. - Keccak concretization is now done only after all simplifications are performed. This helps with simplification pre-concretization - Added an IllegalOverflow error in case the system tries to allocate a large amount of memory during@@ -16,6 +99,7 @@   as the only check is that the size allocated is less than $2**{64}$, but that is too large to fit in memory. Now,   we check more stringently, and still return an IllegalOverflow - Fixed `--root` option for the `test` subcommand+- Use `-Wunused-packages` and eliminate unused deps.  ## Added @@ -38,7 +122,6 @@ - Traces now correctly perform source mapping to display contract details - Event traces now correctly display indexed arguments and argument names - JSON reading of foundry JSONs was dependent on locale and did not work with many locales.-- CVC5 needs `--incremental` flag to work properly in abstraction-refinement mode  ## [0.52.0] - 2023-10-26

bench/bench.hs view

@@ -22,6 +22,7 @@ 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 @@ -81,7 +82,7 @@   result <- Stepper.interpret (Fetch.zero 0 Nothing) vm0 Stepper.runFully   writeTrace vm0 -  maybeReason <- BCTests.checkExpectation False x result+  maybeReason <- BCTests.checkExpectation x result   pure $ isNothing maybeReason  @@ -90,7 +91,7 @@  findPanics :: App m => Solver -> Natural -> Integer -> ByteString -> m () findPanics solver count iters c = do-  _ <- withSolvers solver count Nothing $ \s -> do+  _ <- withSolvers solver count 1 Nothing $ \s -> do     let opts = defaultVeriOpts           { maxIter = Just iters           , askSmtIters = iters + 1@@ -120,17 +121,17 @@ erc20 :: IO ByteString erc20 = do   source <- readFile =<< Paths.getDataFileName "bench/contracts/erc20.sol"-  Just c <- solcRuntime "ERC20" (T.pack source)+  Just c <- runApp $ solcRuntime "ERC20" (T.pack source)   pure c  -- requires solc-0.6.12 to build from source vat :: ByteString-vat = hexByteString "vat" "608060405234801561001057600080fd5b50600436106101c45760003560e01c80637cdd3fde116100f9578063bb35783b11610097578063dc4d20fa11610071578063dc4d20fa1461096c578063f059212a146109b0578063f24e23eb14610a08578063f37ac61c14610a76576101c4565b8063bb35783b14610848578063bf353dbb146108b6578063d9638d361461090e576101c4565b80639c52a7f1116100d35780639c52a7f11461074a578063a3b22fc41461078e578063b65337df146107d2578063babe8a3f1461082a576101c4565b80637cdd3fde14610652578063870c616d146106aa578063957aa58c1461072c576101c4565b80634538c4eb11610166578063692450091161014057806369245009146104ac5780636c25b346146104b6578063760887031461050e5780637bab3f40146105b0576101c4565b80634538c4eb146103785780636111be2e146103f057806365fae35e14610468576101c4565b80632424be5c116101a25780632424be5c1461028b57806329ae8114146102f45780632d61a3551461032c5780633b6631951461034a576101c4565b80630dca59c1146101c95780631a0b287e146101e7578063214414d514610229575b600080fd5b6101d1610aa4565b6040518082815260200191505060405180910390f35b610227600480360360608110156101fd57600080fd5b81019080803590602001909291908035906020019092919080359060200190929190505050610aaa565b005b6102756004803603604081101561023f57600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050610d23565b6040518082815260200191505060405180910390f35b6102d7600480360360408110156102a157600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050610d48565b604051808381526020018281526020019250505060405180910390f35b61032a6004803603604081101561030a57600080fd5b810190808035906020019092919080359060200190929190505050610d79565b005b610334610f4b565b6040518082815260200191505060405180910390f35b6103766004803603602081101561036057600080fd5b8101908080359060200190929190505050610f51565b005b6103da6004803603604081101561038e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506110bb565b6040518082815260200191505060405180910390f35b6104666004803603608081101561040657600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506110e0565b005b6104aa6004803603602081101561047e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506112be565b005b6104b4611431565b005b6104f8600480360360208110156104cc57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506114ef565b6040518082815260200191505060405180910390f35b6105ae600480360360c081101561052457600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919080359060200190929190505050611507565b005b610650600480360360c08110156105c657600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919080359060200190929190505050611cbe565b005b6106a86004803603606081101561066857600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190505050611f88565b005b61072a600480360360a08110156106c057600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190803590602001909291905050506120ef565b005b6107346124ee565b6040518082815260200191505060405180910390f35b61078c6004803603602081101561076057600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506124f4565b005b6107d0600480360360208110156107a457600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612667565b005b610828600480360360608110156107e857600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506126eb565b005b6108326128fb565b6040518082815260200191505060405180910390f35b6108b46004803603606081101561085e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190505050612901565b005b6108f8600480360360208110156108cc57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612a9a565b6040518082815260200191505060405180910390f35b61093a6004803603602081101561092457600080fd5b8101908080359060200190929190505050612ab2565b604051808681526020018581526020018481526020018381526020018281526020019550505050505060405180910390f35b6109ae6004803603602081101561098257600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612ae8565b005b6109f2600480360360208110156109c657600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612b6d565b6040518082815260200191505060405180910390f35b610a7460048036036060811015610a1e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190505050612b85565b005b610aa260048036036020811015610a8c57600080fd5b8101908080359060200190929190505050612d7a565b005b60075481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414610b5e576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414610bd6576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b7f73706f7400000000000000000000000000000000000000000000000000000000821415610c1e57806002600085815260200190815260200160002060020181905550610d1e565b7f6c696e6500000000000000000000000000000000000000000000000000000000821415610c6657806002600085815260200190815260200160002060030181905550610d1d565b7f6475737400000000000000000000000000000000000000000000000000000000821415610cae57806002600085815260200190815260200160002060040181905550610d1c565b6040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601b8152602001807f5661742f66696c652d756e7265636f676e697a65642d706172616d000000000081525060200191505060405180910390fd5b5b5b505050565b6004602052816000526040600020602052806000526040600020600091509150505481565b6003602052816000526040600020602052806000526040600020600091509150508060000154908060010154905082565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414610e2d576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414610ea5576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b7f4c696e6500000000000000000000000000000000000000000000000000000000821415610ed95780600981905550610f47565b6040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601b8152602001807f5661742f66696c652d756e7265636f676e697a65642d706172616d000000000081525060200191505060405180910390fd5b5050565b60085481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414611005576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6000600260008381526020019081526020016000206001015414611091576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f5661742f696c6b2d616c72656164792d696e697400000000000000000000000081525060200191505060405180910390fd5b6b033b2e3c9fd0803ce8000000600260008381526020019081526020016000206001018190555050565b6001602052816000526040600020602052806000526040600020600091509150505481565b6110ea8333612ebf565b61115c576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600f8152602001807f5661742f6e6f742d616c6c6f776564000000000000000000000000000000000081525060200191505060405180910390fd5b6111b66004600086815260200190815260200160002060008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f7f565b6004600086815260200190815260200160002060008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055506112646004600086815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b6004600086815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050505050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414611372576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a54146113ea576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b60016000808373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054146114e5576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6000600a81905550565b60056020528060005260406000206000915090505481565b6001600a541461157f576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b6115876130b2565b6003600088815260200190815260200160002060008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000206040518060400160405290816000820154815260200160018201548152505090506116006130cc565b600260008981526020019081526020016000206040518060a00160405290816000820154815260200160018201548152602001600282015481526020016003820154815260200160048201548152505090506000816020015114156116cd576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260108152602001807f5661742f696c6b2d6e6f742d696e69740000000000000000000000000000000081525060200191505060405180910390fd5b6116db826000015185612fb3565b8260000181815250506116f2826020015184612fb3565b826020018181525050611709816000015184612fb3565b8160000181815250506000611722826020015185612ff2565b905060006117388360200151856020015161302d565b905061174660075483612fb3565b600781905550611782600086131561177d856060015161176e8760000151886020015161302d565b11156009546007541115613059565b613066565b6117f4576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f5661742f6365696c696e672d657863656564656400000000000000000000000081525060200191505060405180910390fd5b61182361180960008713156000891215613059565b61181b8660000151866040015161302d565b831115613066565b611895576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d73616665000000000000000000000000000000000000000081525060200191505060405180910390fd5b6118b96118aa60008713156000891215613059565b6118b48b33612ebf565b613066565b61192b576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f5661742f6e6f742d616c6c6f7765642d7500000000000000000000000000000081525060200191505060405180910390fd5b611942600087131561193d8a33612ebf565b613066565b6119b4576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f5661742f6e6f742d616c6c6f7765642d7600000000000000000000000000000081525060200191505060405180910390fd5b6119cb60008612156119c68933612ebf565b613066565b611a3d576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f5661742f6e6f742d616c6c6f7765642d7700000000000000000000000000000081525060200191505060405180910390fd5b611a5560008560200151148460800151831015613066565b611ac7576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260088152602001807f5661742f6475737400000000000000000000000000000000000000000000000081525060200191505060405180910390fd5b611b21600460008c815260200190815260200160002060008a73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205487613073565b600460008c815260200190815260200160002060008a73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550611bbe600560008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205483612fb3565b600560008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555083600360008c815260200190815260200160002060008b73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600082015181600001556020820151816001015590505082600260008c8152602001908152602001600020600082015181600001556020820151816001015560408201518160020155606082015181600301556080820151816004015590505050505050505050505050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414611d72576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b60006003600088815260200190815260200160002060008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002090506000600260008981526020019081526020016000209050611deb826000015485612fb3565b8260000181905550611e01826001015484612fb3565b8260010181905550611e17816000015484612fb3565b81600001819055506000611e2f826001015485612ff2565b9050611e8b600460008b815260200190815260200160002060008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205486613073565b600460008b815260200190815260200160002060008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550611f28600660008873ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482613073565b600660008873ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550611f7760085482613073565b600881905550505050505050505050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020541461203c576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6120966004600085815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612fb3565b6004600085815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550505050565b60006003600087815260200190815260200160002060008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020905060006003600088815260200190815260200160002060008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020905060006002600089815260200190815260200160002090506121bc836000015486613073565b83600001819055506121d2836001015485613073565b83600101819055506121e8826000015486612fb3565b82600001819055506121fe826001015485612fb3565b8260010181905550600061221a8460010154836001015461302d565b905060006122308460010154846001015461302d565b905061224e61223f8a33612ebf565b6122498a33612ebf565b613059565b6122c0576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600f8152602001807f5661742f6e6f742d616c6c6f776564000000000000000000000000000000000081525060200191505060405180910390fd5b6122d28560000154846002015461302d565b821115612347576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260108152602001807f5661742f6e6f742d736166652d7372630000000000000000000000000000000081525060200191505060405180910390fd5b6123598460000154846002015461302d565b8111156123ce576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260108152602001807f5661742f6e6f742d736166652d6473740000000000000000000000000000000081525060200191505060405180910390fd5b6123e683600401548310156000876001015414613066565b612458576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f647573742d737263000000000000000000000000000000000000000081525060200191505060405180910390fd5b61247083600401548210156000866001015414613066565b6124e2576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f647573742d647374000000000000000000000000000000000000000081525060200191505060405180910390fd5b50505050505050505050565b600a5481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054146125a8576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414612620576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b60008060008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60018060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020541461279f576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414612817576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b600060026000858152602001908152602001600020905061283c816001015483612fb3565b81600101819055506000612854826000015484612ff2565b905061289f600560008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612fb3565b600560008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055506128ee60075482612fb3565b6007819055505050505050565b60095481565b61290b8333612ebf565b61297d576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600f8152602001807f5661742f6e6f742d616c6c6f776564000000000000000000000000000000000081525060200191505060405180910390fd5b6129c6600560008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f7f565b600560008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612a52600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550505050565b60006020528060005260406000206000915090505481565b60026020528060005260406000206000915090508060000154908060010154908060020154908060030154908060040154905085565b6000600160003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60066020528060005260406000206000915090505481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414612c39576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b612c82600660008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b600660008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612d0e600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612d5d60085482612f99565b600881905550612d6f60075482612f99565b600781905550505050565b6000339050612dc8600660008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205483612f7f565b600660008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612e54600560008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205483612f7f565b600560008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612ea360085483612f7f565b600881905550612eb560075483612f7f565b6007819055505050565b6000612f778273ffffffffffffffffffffffffffffffffffffffff168473ffffffffffffffffffffffffffffffffffffffff161460018060008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414613066565b905092915050565b6000828284039150811115612f9357600080fd5b92915050565b6000828284019150811015612fad57600080fd5b92915050565b60008183019050600082121580612fca5750828111155b612fd357600080fd5b600082131580612fe35750828110155b612fec57600080fd5b92915050565b60008183029050600083121561300757600080fd5b600082148061301e57508282828161301b57fe5b05145b61302757600080fd5b92915050565b60008082148061304a575082828385029250828161304757fe5b04145b61305357600080fd5b92915050565b6000818316905092915050565b6000818317905092915050565b6000818303905060008213158061308a5750828111155b61309357600080fd5b6000821215806130a35750828110155b6130ac57600080fd5b92915050565b604051806040016040528060008152602001600081525090565b6040518060a001604052806000815260200160008152602001600081526020016000815260200160008152509056fea2646970667358221220a6981c73e66c77a4325e4426a14f7d3876fbe831438d34792d1fdac37b02a51d64736f6c634300060c0033"+vat = fromJust $ hexByteString "608060405234801561001057600080fd5b50600436106101c45760003560e01c80637cdd3fde116100f9578063bb35783b11610097578063dc4d20fa11610071578063dc4d20fa1461096c578063f059212a146109b0578063f24e23eb14610a08578063f37ac61c14610a76576101c4565b8063bb35783b14610848578063bf353dbb146108b6578063d9638d361461090e576101c4565b80639c52a7f1116100d35780639c52a7f11461074a578063a3b22fc41461078e578063b65337df146107d2578063babe8a3f1461082a576101c4565b80637cdd3fde14610652578063870c616d146106aa578063957aa58c1461072c576101c4565b80634538c4eb11610166578063692450091161014057806369245009146104ac5780636c25b346146104b6578063760887031461050e5780637bab3f40146105b0576101c4565b80634538c4eb146103785780636111be2e146103f057806365fae35e14610468576101c4565b80632424be5c116101a25780632424be5c1461028b57806329ae8114146102f45780632d61a3551461032c5780633b6631951461034a576101c4565b80630dca59c1146101c95780631a0b287e146101e7578063214414d514610229575b600080fd5b6101d1610aa4565b6040518082815260200191505060405180910390f35b610227600480360360608110156101fd57600080fd5b81019080803590602001909291908035906020019092919080359060200190929190505050610aaa565b005b6102756004803603604081101561023f57600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050610d23565b6040518082815260200191505060405180910390f35b6102d7600480360360408110156102a157600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050610d48565b604051808381526020018281526020019250505060405180910390f35b61032a6004803603604081101561030a57600080fd5b810190808035906020019092919080359060200190929190505050610d79565b005b610334610f4b565b6040518082815260200191505060405180910390f35b6103766004803603602081101561036057600080fd5b8101908080359060200190929190505050610f51565b005b6103da6004803603604081101561038e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506110bb565b6040518082815260200191505060405180910390f35b6104666004803603608081101561040657600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506110e0565b005b6104aa6004803603602081101561047e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506112be565b005b6104b4611431565b005b6104f8600480360360208110156104cc57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506114ef565b6040518082815260200191505060405180910390f35b6105ae600480360360c081101561052457600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919080359060200190929190505050611507565b005b610650600480360360c08110156105c657600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919080359060200190929190505050611cbe565b005b6106a86004803603606081101561066857600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190505050611f88565b005b61072a600480360360a08110156106c057600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190803590602001909291905050506120ef565b005b6107346124ee565b6040518082815260200191505060405180910390f35b61078c6004803603602081101561076057600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506124f4565b005b6107d0600480360360208110156107a457600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612667565b005b610828600480360360608110156107e857600080fd5b8101908080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506126eb565b005b6108326128fb565b6040518082815260200191505060405180910390f35b6108b46004803603606081101561085e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190505050612901565b005b6108f8600480360360208110156108cc57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612a9a565b6040518082815260200191505060405180910390f35b61093a6004803603602081101561092457600080fd5b8101908080359060200190929190505050612ab2565b604051808681526020018581526020018481526020018381526020018281526020019550505050505060405180910390f35b6109ae6004803603602081101561098257600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612ae8565b005b6109f2600480360360208110156109c657600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050612b6d565b6040518082815260200191505060405180910390f35b610a7460048036036060811015610a1e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff16906020019092919080359060200190929190505050612b85565b005b610aa260048036036020811015610a8c57600080fd5b8101908080359060200190929190505050612d7a565b005b60075481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414610b5e576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414610bd6576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b7f73706f7400000000000000000000000000000000000000000000000000000000821415610c1e57806002600085815260200190815260200160002060020181905550610d1e565b7f6c696e6500000000000000000000000000000000000000000000000000000000821415610c6657806002600085815260200190815260200160002060030181905550610d1d565b7f6475737400000000000000000000000000000000000000000000000000000000821415610cae57806002600085815260200190815260200160002060040181905550610d1c565b6040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601b8152602001807f5661742f66696c652d756e7265636f676e697a65642d706172616d000000000081525060200191505060405180910390fd5b5b5b505050565b6004602052816000526040600020602052806000526040600020600091509150505481565b6003602052816000526040600020602052806000526040600020600091509150508060000154908060010154905082565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414610e2d576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414610ea5576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b7f4c696e6500000000000000000000000000000000000000000000000000000000821415610ed95780600981905550610f47565b6040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601b8152602001807f5661742f66696c652d756e7265636f676e697a65642d706172616d000000000081525060200191505060405180910390fd5b5050565b60085481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414611005576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6000600260008381526020019081526020016000206001015414611091576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f5661742f696c6b2d616c72656164792d696e697400000000000000000000000081525060200191505060405180910390fd5b6b033b2e3c9fd0803ce8000000600260008381526020019081526020016000206001018190555050565b6001602052816000526040600020602052806000526040600020600091509150505481565b6110ea8333612ebf565b61115c576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600f8152602001807f5661742f6e6f742d616c6c6f776564000000000000000000000000000000000081525060200191505060405180910390fd5b6111b66004600086815260200190815260200160002060008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f7f565b6004600086815260200190815260200160002060008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055506112646004600086815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b6004600086815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050505050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414611372576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a54146113ea576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b60016000808373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054146114e5576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6000600a81905550565b60056020528060005260406000206000915090505481565b6001600a541461157f576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b6115876130b2565b6003600088815260200190815260200160002060008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000206040518060400160405290816000820154815260200160018201548152505090506116006130cc565b600260008981526020019081526020016000206040518060a00160405290816000820154815260200160018201548152602001600282015481526020016003820154815260200160048201548152505090506000816020015114156116cd576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260108152602001807f5661742f696c6b2d6e6f742d696e69740000000000000000000000000000000081525060200191505060405180910390fd5b6116db826000015185612fb3565b8260000181815250506116f2826020015184612fb3565b826020018181525050611709816000015184612fb3565b8160000181815250506000611722826020015185612ff2565b905060006117388360200151856020015161302d565b905061174660075483612fb3565b600781905550611782600086131561177d856060015161176e8760000151886020015161302d565b11156009546007541115613059565b613066565b6117f4576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f5661742f6365696c696e672d657863656564656400000000000000000000000081525060200191505060405180910390fd5b61182361180960008713156000891215613059565b61181b8660000151866040015161302d565b831115613066565b611895576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d73616665000000000000000000000000000000000000000081525060200191505060405180910390fd5b6118b96118aa60008713156000891215613059565b6118b48b33612ebf565b613066565b61192b576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f5661742f6e6f742d616c6c6f7765642d7500000000000000000000000000000081525060200191505060405180910390fd5b611942600087131561193d8a33612ebf565b613066565b6119b4576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f5661742f6e6f742d616c6c6f7765642d7600000000000000000000000000000081525060200191505060405180910390fd5b6119cb60008612156119c68933612ebf565b613066565b611a3d576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f5661742f6e6f742d616c6c6f7765642d7700000000000000000000000000000081525060200191505060405180910390fd5b611a5560008560200151148460800151831015613066565b611ac7576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260088152602001807f5661742f6475737400000000000000000000000000000000000000000000000081525060200191505060405180910390fd5b611b21600460008c815260200190815260200160002060008a73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205487613073565b600460008c815260200190815260200160002060008a73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550611bbe600560008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205483612fb3565b600560008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555083600360008c815260200190815260200160002060008b73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600082015181600001556020820151816001015590505082600260008c8152602001908152602001600020600082015181600001556020820151816001015560408201518160020155606082015181600301556080820151816004015590505050505050505050505050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414611d72576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b60006003600088815260200190815260200160002060008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002090506000600260008981526020019081526020016000209050611deb826000015485612fb3565b8260000181905550611e01826001015484612fb3565b8260010181905550611e17816000015484612fb3565b81600001819055506000611e2f826001015485612ff2565b9050611e8b600460008b815260200190815260200160002060008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205486613073565b600460008b815260200190815260200160002060008973ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550611f28600660008873ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482613073565b600660008873ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550611f7760085482613073565b600881905550505050505050505050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020541461203c576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6120966004600085815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612fb3565b6004600085815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550505050565b60006003600087815260200190815260200160002060008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020905060006003600088815260200190815260200160002060008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020905060006002600089815260200190815260200160002090506121bc836000015486613073565b83600001819055506121d2836001015485613073565b83600101819055506121e8826000015486612fb3565b82600001819055506121fe826001015485612fb3565b8260010181905550600061221a8460010154836001015461302d565b905060006122308460010154846001015461302d565b905061224e61223f8a33612ebf565b6122498a33612ebf565b613059565b6122c0576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600f8152602001807f5661742f6e6f742d616c6c6f776564000000000000000000000000000000000081525060200191505060405180910390fd5b6122d28560000154846002015461302d565b821115612347576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260108152602001807f5661742f6e6f742d736166652d7372630000000000000000000000000000000081525060200191505060405180910390fd5b6123598460000154846002015461302d565b8111156123ce576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260108152602001807f5661742f6e6f742d736166652d6473740000000000000000000000000000000081525060200191505060405180910390fd5b6123e683600401548310156000876001015414613066565b612458576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f647573742d737263000000000000000000000000000000000000000081525060200191505060405180910390fd5b61247083600401548210156000866001015414613066565b6124e2576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f647573742d647374000000000000000000000000000000000000000081525060200191505060405180910390fd5b50505050505050505050565b600a5481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054146125a8576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414612620576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b60008060008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60018060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020541461279f576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b6001600a5414612817576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f5661742f6e6f742d6c697665000000000000000000000000000000000000000081525060200191505060405180910390fd5b600060026000858152602001908152602001600020905061283c816001015483612fb3565b81600101819055506000612854826000015484612ff2565b905061289f600560008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612fb3565b600560008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055506128ee60075482612fb3565b6007819055505050505050565b60095481565b61290b8333612ebf565b61297d576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600f8152602001807f5661742f6e6f742d616c6c6f776564000000000000000000000000000000000081525060200191505060405180910390fd5b6129c6600560008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f7f565b600560008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612a52600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550505050565b60006020528060005260406000206000915090505481565b60026020528060005260406000206000915090508060000154908060010154908060020154908060030154908060040154905085565b6000600160003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555050565b60066020528060005260406000206000915090505481565b60016000803373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414612c39576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f5661742f6e6f742d617574686f72697a6564000000000000000000000000000081525060200191505060405180910390fd5b612c82600660008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b600660008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612d0e600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205482612f99565b600560008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612d5d60085482612f99565b600881905550612d6f60075482612f99565b600781905550505050565b6000339050612dc8600660008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205483612f7f565b600660008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612e54600560008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205483612f7f565b600560008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002081905550612ea360085483612f7f565b600881905550612eb560075483612f7f565b6007819055505050565b6000612f778273ffffffffffffffffffffffffffffffffffffffff168473ffffffffffffffffffffffffffffffffffffffff161460018060008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205414613066565b905092915050565b6000828284039150811115612f9357600080fd5b92915050565b6000828284019150811015612fad57600080fd5b92915050565b60008183019050600082121580612fca5750828111155b612fd357600080fd5b600082131580612fe35750828110155b612fec57600080fd5b92915050565b60008183029050600083121561300757600080fd5b600082148061301e57508282828161301b57fe5b05145b61302757600080fd5b92915050565b60008082148061304a575082828385029250828161304757fe5b04145b61305357600080fd5b92915050565b6000818316905092915050565b6000818317905092915050565b6000818303905060008213158061308a5750828111155b61309357600080fd5b6000821215806130a35750828110155b6130ac57600080fd5b92915050565b604051806040016040528060008152602001600081525090565b6040518060a001604052806000815260200160008152602001600081526020016000815260200160008152509056fea2646970667358221220a6981c73e66c77a4325e4426a14f7d3876fbe831438d34792d1fdac37b02a51d64736f6c634300060c0033"  -- requires solc-0.6.13 to build deposit :: ByteString-deposit = hexByteString "deposit" "60806040526004361061003f5760003560e01c806301ffc9a71461004457806322895118146100b6578063621fd130146101e3578063c5f2892f14610273575b600080fd5b34801561005057600080fd5b5061009c6004803603602081101561006757600080fd5b8101908080357bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916906020019092919050505061029e565b604051808215151515815260200191505060405180910390f35b6101e1600480360360808110156100cc57600080fd5b81019080803590602001906401000000008111156100e957600080fd5b8201836020820111156100fb57600080fd5b8035906020019184600183028401116401000000008311171561011d57600080fd5b90919293919293908035906020019064010000000081111561013e57600080fd5b82018360208201111561015057600080fd5b8035906020019184600183028401116401000000008311171561017257600080fd5b90919293919293908035906020019064010000000081111561019357600080fd5b8201836020820111156101a557600080fd5b803590602001918460018302840111640100000000831117156101c757600080fd5b909192939192939080359060200190929190505050610370565b005b3480156101ef57600080fd5b506101f8610fd0565b6040518080602001828103825283818151815260200191508051906020019080838360005b8381101561023857808201518184015260208101905061021d565b50505050905090810190601f1680156102655780820380516001836020036101000a031916815260200191505b509250505060405180910390f35b34801561027f57600080fd5b50610288610fe2565b6040518082815260200191505060405180910390f35b60007f01ffc9a7000000000000000000000000000000000000000000000000000000007bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916827bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916148061036957507f85640907000000000000000000000000000000000000000000000000000000007bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916827bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916145b9050919050565b603087879050146103cc576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260268152602001806116ec6026913960400191505060405180910390fd5b60208585905014610428576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260368152602001806116836036913960400191505060405180910390fd5b60608383905014610484576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252602981526020018061175f6029913960400191505060405180910390fd5b670de0b6b3a76400003410156104e5576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260268152602001806117396026913960400191505060405180910390fd5b6000633b9aca0034816104f457fe5b061461054b576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260338152602001806116b96033913960400191505060405180910390fd5b6000633b9aca00348161055a57fe5b04905067ffffffffffffffff80168111156105c0576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260278152602001806117126027913960400191505060405180910390fd5b60606105cb82611314565b90507f649bbc62d0e31342afea4e5cd82d4049e7e1ee912fc0889aa790803be39038c589898989858a8a610600602054611314565b60405180806020018060200180602001806020018060200186810386528e8e82818152602001925080828437600081840152601f19601f82011690508083019250505086810385528c8c82818152602001925080828437600081840152601f19601f82011690508083019250505086810384528a818151815260200191508051906020019080838360005b838110156106a657808201518184015260208101905061068b565b50505050905090810190601f1680156106d35780820380516001836020036101000a031916815260200191505b508681038352898982818152602001925080828437600081840152601f19601f820116905080830192505050868103825287818151815260200191508051906020019080838360005b8381101561073757808201518184015260208101905061071c565b50505050905090810190601f1680156107645780820380516001836020036101000a031916815260200191505b509d505050505050505050505050505060405180910390a1600060028a8a600060801b6040516020018084848082843780830192505050826fffffffffffffffffffffffffffffffff19166fffffffffffffffffffffffffffffffff1916815260100193505050506040516020818303038152906040526040518082805190602001908083835b6020831061080e57805182526020820191506020810190506020830392506107eb565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610850573d6000803e3d6000fd5b5050506040513d602081101561086557600080fd5b8101908080519060200190929190505050905060006002808888600090604092610891939291906115da565b6040516020018083838082843780830192505050925050506040516020818303038152906040526040518082805190602001908083835b602083106108eb57805182526020820191506020810190506020830392506108c8565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa15801561092d573d6000803e3d6000fd5b5050506040513d602081101561094257600080fd5b8101908080519060200190929190505050600289896040908092610968939291906115da565b6000801b604051602001808484808284378083019250505082815260200193505050506040516020818303038152906040526040518082805190602001908083835b602083106109cd57805182526020820191506020810190506020830392506109aa565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610a0f573d6000803e3d6000fd5b5050506040513d6020811015610a2457600080fd5b810190808051906020019092919050505060405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310610a8e5780518252602082019150602081019050602083039250610a6b565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610ad0573d6000803e3d6000fd5b5050506040513d6020811015610ae557600080fd5b810190808051906020019092919050505090506000600280848c8c604051602001808481526020018383808284378083019250505093505050506040516020818303038152906040526040518082805190602001908083835b60208310610b615780518252602082019150602081019050602083039250610b3e565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610ba3573d6000803e3d6000fd5b5050506040513d6020811015610bb857600080fd5b8101908080519060200190929190505050600286600060401b866040516020018084805190602001908083835b60208310610c085780518252602082019150602081019050602083039250610be5565b6001836020036101000a0380198251168184511680821785525050505050509050018367ffffffffffffffff191667ffffffffffffffff1916815260180182815260200193505050506040516020818303038152906040526040518082805190602001908083835b60208310610c935780518252602082019150602081019050602083039250610c70565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610cd5573d6000803e3d6000fd5b5050506040513d6020811015610cea57600080fd5b810190808051906020019092919050505060405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310610d545780518252602082019150602081019050602083039250610d31565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610d96573d6000803e3d6000fd5b5050506040513d6020811015610dab57600080fd5b81019080805190602001909291905050509050858114610e16576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252605481526020018061162f6054913960600191505060405180910390fd5b6001602060020a0360205410610e77576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252602181526020018061160e6021913960400191505060405180910390fd5b60016020600082825401925050819055506000602054905060008090505b6020811015610fb75760018083161415610ec8578260008260208110610eb757fe5b018190555050505050505050610fc7565b600260008260208110610ed757fe5b01548460405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310610f335780518252602082019150602081019050602083039250610f10565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610f75573d6000803e3d6000fd5b5050506040513d6020811015610f8a57600080fd5b8101908080519060200190929190505050925060028281610fa757fe5b0491508080600101915050610e95565b506000610fc057fe5b5050505050505b50505050505050565b6060610fdd602054611314565b905090565b6000806000602054905060008090505b60208110156111d057600180831614156110e05760026000826020811061101557fe5b01548460405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310611071578051825260208201915060208101905060208303925061104e565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa1580156110b3573d6000803e3d6000fd5b5050506040513d60208110156110c857600080fd5b810190808051906020019092919050505092506111b6565b600283602183602081106110f057fe5b015460405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b6020831061114b5780518252602082019150602081019050602083039250611128565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa15801561118d573d6000803e3d6000fd5b5050506040513d60208110156111a257600080fd5b810190808051906020019092919050505092505b600282816111c057fe5b0491508080600101915050610ff2565b506002826111df602054611314565b600060401b6040516020018084815260200183805190602001908083835b6020831061122057805182526020820191506020810190506020830392506111fd565b6001836020036101000a0380198251168184511680821785525050505050509050018267ffffffffffffffff191667ffffffffffffffff1916815260180193505050506040516020818303038152906040526040518082805190602001908083835b602083106112a55780518252602082019150602081019050602083039250611282565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa1580156112e7573d6000803e3d6000fd5b5050506040513d60208110156112fc57600080fd5b81019080805190602001909291905050509250505090565b6060600867ffffffffffffffff8111801561132e57600080fd5b506040519080825280601f01601f1916602001820160405280156113615781602001600182028036833780820191505090505b50905060008260c01b90508060076008811061137957fe5b1a60f81b8260008151811061138a57fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a905350806006600881106113c657fe5b1a60f81b826001815181106113d757fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060056008811061141357fe5b1a60f81b8260028151811061142457fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060046008811061146057fe5b1a60f81b8260038151811061147157fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a905350806003600881106114ad57fe5b1a60f81b826004815181106114be57fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a905350806002600881106114fa57fe5b1a60f81b8260058151811061150b57fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060016008811061154757fe5b1a60f81b8260068151811061155857fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060006008811061159457fe5b1a60f81b826007815181106115a557fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a90535050919050565b600080858511156115ea57600080fd5b838611156115f757600080fd5b600185028301915084860390509450949250505056fe4465706f736974436f6e74726163743a206d65726b6c6520747265652066756c6c4465706f736974436f6e74726163743a207265636f6e7374727563746564204465706f7369744461746120646f6573206e6f74206d6174636820737570706c696564206465706f7369745f646174615f726f6f744465706f736974436f6e74726163743a20696e76616c6964207769746864726177616c5f63726564656e7469616c73206c656e6774684465706f736974436f6e74726163743a206465706f7369742076616c7565206e6f74206d756c7469706c65206f6620677765694465706f736974436f6e74726163743a20696e76616c6964207075626b6579206c656e6774684465706f736974436f6e74726163743a206465706f7369742076616c756520746f6f20686967684465706f736974436f6e74726163743a206465706f7369742076616c756520746f6f206c6f774465706f736974436f6e74726163743a20696e76616c6964207369676e6174757265206c656e677468a2646970667358221220e859959599195b69dd53a5a8e7d6218056606794a75a0aadd9fecf8dc64eae7064736f6c634300060b0033"+deposit = fromJust $ hexByteString "60806040526004361061003f5760003560e01c806301ffc9a71461004457806322895118146100b6578063621fd130146101e3578063c5f2892f14610273575b600080fd5b34801561005057600080fd5b5061009c6004803603602081101561006757600080fd5b8101908080357bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916906020019092919050505061029e565b604051808215151515815260200191505060405180910390f35b6101e1600480360360808110156100cc57600080fd5b81019080803590602001906401000000008111156100e957600080fd5b8201836020820111156100fb57600080fd5b8035906020019184600183028401116401000000008311171561011d57600080fd5b90919293919293908035906020019064010000000081111561013e57600080fd5b82018360208201111561015057600080fd5b8035906020019184600183028401116401000000008311171561017257600080fd5b90919293919293908035906020019064010000000081111561019357600080fd5b8201836020820111156101a557600080fd5b803590602001918460018302840111640100000000831117156101c757600080fd5b909192939192939080359060200190929190505050610370565b005b3480156101ef57600080fd5b506101f8610fd0565b6040518080602001828103825283818151815260200191508051906020019080838360005b8381101561023857808201518184015260208101905061021d565b50505050905090810190601f1680156102655780820380516001836020036101000a031916815260200191505b509250505060405180910390f35b34801561027f57600080fd5b50610288610fe2565b6040518082815260200191505060405180910390f35b60007f01ffc9a7000000000000000000000000000000000000000000000000000000007bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916827bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916148061036957507f85640907000000000000000000000000000000000000000000000000000000007bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916827bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916145b9050919050565b603087879050146103cc576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260268152602001806116ec6026913960400191505060405180910390fd5b60208585905014610428576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260368152602001806116836036913960400191505060405180910390fd5b60608383905014610484576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252602981526020018061175f6029913960400191505060405180910390fd5b670de0b6b3a76400003410156104e5576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260268152602001806117396026913960400191505060405180910390fd5b6000633b9aca0034816104f457fe5b061461054b576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260338152602001806116b96033913960400191505060405180910390fd5b6000633b9aca00348161055a57fe5b04905067ffffffffffffffff80168111156105c0576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260278152602001806117126027913960400191505060405180910390fd5b60606105cb82611314565b90507f649bbc62d0e31342afea4e5cd82d4049e7e1ee912fc0889aa790803be39038c589898989858a8a610600602054611314565b60405180806020018060200180602001806020018060200186810386528e8e82818152602001925080828437600081840152601f19601f82011690508083019250505086810385528c8c82818152602001925080828437600081840152601f19601f82011690508083019250505086810384528a818151815260200191508051906020019080838360005b838110156106a657808201518184015260208101905061068b565b50505050905090810190601f1680156106d35780820380516001836020036101000a031916815260200191505b508681038352898982818152602001925080828437600081840152601f19601f820116905080830192505050868103825287818151815260200191508051906020019080838360005b8381101561073757808201518184015260208101905061071c565b50505050905090810190601f1680156107645780820380516001836020036101000a031916815260200191505b509d505050505050505050505050505060405180910390a1600060028a8a600060801b6040516020018084848082843780830192505050826fffffffffffffffffffffffffffffffff19166fffffffffffffffffffffffffffffffff1916815260100193505050506040516020818303038152906040526040518082805190602001908083835b6020831061080e57805182526020820191506020810190506020830392506107eb565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610850573d6000803e3d6000fd5b5050506040513d602081101561086557600080fd5b8101908080519060200190929190505050905060006002808888600090604092610891939291906115da565b6040516020018083838082843780830192505050925050506040516020818303038152906040526040518082805190602001908083835b602083106108eb57805182526020820191506020810190506020830392506108c8565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa15801561092d573d6000803e3d6000fd5b5050506040513d602081101561094257600080fd5b8101908080519060200190929190505050600289896040908092610968939291906115da565b6000801b604051602001808484808284378083019250505082815260200193505050506040516020818303038152906040526040518082805190602001908083835b602083106109cd57805182526020820191506020810190506020830392506109aa565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610a0f573d6000803e3d6000fd5b5050506040513d6020811015610a2457600080fd5b810190808051906020019092919050505060405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310610a8e5780518252602082019150602081019050602083039250610a6b565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610ad0573d6000803e3d6000fd5b5050506040513d6020811015610ae557600080fd5b810190808051906020019092919050505090506000600280848c8c604051602001808481526020018383808284378083019250505093505050506040516020818303038152906040526040518082805190602001908083835b60208310610b615780518252602082019150602081019050602083039250610b3e565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610ba3573d6000803e3d6000fd5b5050506040513d6020811015610bb857600080fd5b8101908080519060200190929190505050600286600060401b866040516020018084805190602001908083835b60208310610c085780518252602082019150602081019050602083039250610be5565b6001836020036101000a0380198251168184511680821785525050505050509050018367ffffffffffffffff191667ffffffffffffffff1916815260180182815260200193505050506040516020818303038152906040526040518082805190602001908083835b60208310610c935780518252602082019150602081019050602083039250610c70565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610cd5573d6000803e3d6000fd5b5050506040513d6020811015610cea57600080fd5b810190808051906020019092919050505060405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310610d545780518252602082019150602081019050602083039250610d31565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610d96573d6000803e3d6000fd5b5050506040513d6020811015610dab57600080fd5b81019080805190602001909291905050509050858114610e16576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252605481526020018061162f6054913960600191505060405180910390fd5b6001602060020a0360205410610e77576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252602181526020018061160e6021913960400191505060405180910390fd5b60016020600082825401925050819055506000602054905060008090505b6020811015610fb75760018083161415610ec8578260008260208110610eb757fe5b018190555050505050505050610fc7565b600260008260208110610ed757fe5b01548460405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310610f335780518252602082019150602081019050602083039250610f10565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa158015610f75573d6000803e3d6000fd5b5050506040513d6020811015610f8a57600080fd5b8101908080519060200190929190505050925060028281610fa757fe5b0491508080600101915050610e95565b506000610fc057fe5b5050505050505b50505050505050565b6060610fdd602054611314565b905090565b6000806000602054905060008090505b60208110156111d057600180831614156110e05760026000826020811061101557fe5b01548460405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b60208310611071578051825260208201915060208101905060208303925061104e565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa1580156110b3573d6000803e3d6000fd5b5050506040513d60208110156110c857600080fd5b810190808051906020019092919050505092506111b6565b600283602183602081106110f057fe5b015460405160200180838152602001828152602001925050506040516020818303038152906040526040518082805190602001908083835b6020831061114b5780518252602082019150602081019050602083039250611128565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa15801561118d573d6000803e3d6000fd5b5050506040513d60208110156111a257600080fd5b810190808051906020019092919050505092505b600282816111c057fe5b0491508080600101915050610ff2565b506002826111df602054611314565b600060401b6040516020018084815260200183805190602001908083835b6020831061122057805182526020820191506020810190506020830392506111fd565b6001836020036101000a0380198251168184511680821785525050505050509050018267ffffffffffffffff191667ffffffffffffffff1916815260180193505050506040516020818303038152906040526040518082805190602001908083835b602083106112a55780518252602082019150602081019050602083039250611282565b6001836020036101000a038019825116818451168082178552505050505050905001915050602060405180830381855afa1580156112e7573d6000803e3d6000fd5b5050506040513d60208110156112fc57600080fd5b81019080805190602001909291905050509250505090565b6060600867ffffffffffffffff8111801561132e57600080fd5b506040519080825280601f01601f1916602001820160405280156113615781602001600182028036833780820191505090505b50905060008260c01b90508060076008811061137957fe5b1a60f81b8260008151811061138a57fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a905350806006600881106113c657fe5b1a60f81b826001815181106113d757fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060056008811061141357fe5b1a60f81b8260028151811061142457fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060046008811061146057fe5b1a60f81b8260038151811061147157fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a905350806003600881106114ad57fe5b1a60f81b826004815181106114be57fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a905350806002600881106114fa57fe5b1a60f81b8260058151811061150b57fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060016008811061154757fe5b1a60f81b8260068151811061155857fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a9053508060006008811061159457fe5b1a60f81b826007815181106115a557fe5b60200101907effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1916908160001a90535050919050565b600080858511156115ea57600080fd5b838611156115f757600080fd5b600185028301915084860390509450949250505056fe4465706f736974436f6e74726163743a206d65726b6c6520747265652066756c6c4465706f736974436f6e74726163743a207265636f6e7374727563746564204465706f7369744461746120646f6573206e6f74206d6174636820737570706c696564206465706f7369745f646174615f726f6f744465706f736974436f6e74726163743a20696e76616c6964207769746864726177616c5f63726564656e7469616c73206c656e6774684465706f736974436f6e74726163743a206465706f7369742076616c7565206e6f74206d756c7469706c65206f6620677765694465706f736974436f6e74726163743a20696e76616c6964207075626b6579206c656e6774684465706f736974436f6e74726163743a206465706f7369742076616c756520746f6f20686967684465706f736974436f6e74726163743a206465706f7369742076616c756520746f6f206c6f774465706f736974436f6e74726163743a20696e76616c6964207369676e6174757265206c656e677468a2646970667358221220e859959599195b69dd53a5a8e7d6218056606794a75a0aadd9fecf8dc64eae7064736f6c634300060b0033"  -- requires waffle to be installed to build uniV2Pair :: ByteString-uniV2Pair = hexByteString "uniV2" "608060405234801561001057600080fd5b50600436106101a95760003560e01c80636a627842116100f9578063ba9a7a5611610097578063d21220a711610071578063d21220a7146108c4578063d505accf1461090e578063dd62ed3e146109a7578063fff6cae914610a1f576101a9565b8063ba9a7a5614610818578063bc25cf7714610836578063c45a01551461087a576101a9565b80637ecebe00116100d35780637ecebe001461067857806389afcb44146106d057806395d89b411461072f578063a9059cbb146107b2576101a9565b80636a627842146105aa57806370a08231146106025780637464fc3d1461065a576101a9565b806323b872dd116101665780633644e515116101405780633644e515146104ec578063485cc9551461050a5780635909c0d51461056e5780635a3d54931461058c576101a9565b806323b872dd1461042457806330adf81f146104aa578063313ce567146104c8576101a9565b8063022c0d9f146101ae57806306fdde031461025b5780630902f1ac146102de578063095ea7b3146103565780630dfe1681146103bc57806318160ddd14610406575b600080fd5b610259600480360360808110156101c457600080fd5b810190808035906020019092919080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019064010000000081111561021557600080fd5b82018360208201111561022757600080fd5b8035906020019184600183028401116401000000008311171561024957600080fd5b9091929391929390505050610a29565b005b610263611216565b6040518080602001828103825283818151815260200191508051906020019080838360005b838110156102a3578082015181840152602081019050610288565b50505050905090810190601f1680156102d05780820380516001836020036101000a031916815260200191505b509250505060405180910390f35b6102e661124f565b60405180846dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168152602001836dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff1681526020018263ffffffff1663ffffffff168152602001935050505060405180910390f35b6103a26004803603604081101561036c57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506112ac565b604051808215151515815260200191505060405180910390f35b6103c46112c3565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b61040e6112e9565b6040518082815260200191505060405180910390f35b6104906004803603606081101561043a57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506112ef565b604051808215151515815260200191505060405180910390f35b6104b26114ba565b6040518082815260200191505060405180910390f35b6104d06114e1565b604051808260ff1660ff16815260200191505060405180910390f35b6104f46114e6565b6040518082815260200191505060405180910390f35b61056c6004803603604081101561052057600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506114ec565b005b610576611635565b6040518082815260200191505060405180910390f35b61059461163b565b6040518082815260200191505060405180910390f35b6105ec600480360360208110156105c057600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611641565b6040518082815260200191505060405180910390f35b6106446004803603602081101561061857600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611af2565b6040518082815260200191505060405180910390f35b610662611b0a565b6040518082815260200191505060405180910390f35b6106ba6004803603602081101561068e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611b10565b6040518082815260200191505060405180910390f35b610712600480360360208110156106e657600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611b28565b604051808381526020018281526020019250505060405180910390f35b610737612115565b6040518080602001828103825283818151815260200191508051906020019080838360005b8381101561077757808201518184015260208101905061075c565b50505050905090810190601f1680156107a45780820380516001836020036101000a031916815260200191505b509250505060405180910390f35b6107fe600480360360408110156107c857600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919050505061214e565b604051808215151515815260200191505060405180910390f35b610820612165565b6040518082815260200191505060405180910390f35b6108786004803603602081101561084c57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff16906020019092919050505061216b565b005b610882612446565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b6108cc61246c565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b6109a5600480360360e081101561092457600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919080359060200190929190803560ff1690602001909291908035906020019092919080359060200190929190505050612492565b005b610a09600480360360408110156109bd57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506127d6565b6040518082815260200191505060405180910390f35b610a276127fb565b005b6001600c5414610aa1576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c819055506000851180610ab85750600084115b610b0d576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252602581526020018061397c6025913960400191505060405180910390fd5b600080610b1861124f565b5091509150816dffffffffffffffffffffffffffff1687108015610b4b5750806dffffffffffffffffffffffffffff1686105b610ba0576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260218152602001806139c56021913960400191505060405180910390fd5b6000806000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690508173ffffffffffffffffffffffffffffffffffffffff168973ffffffffffffffffffffffffffffffffffffffff1614158015610c5957508073ffffffffffffffffffffffffffffffffffffffff168973ffffffffffffffffffffffffffffffffffffffff1614155b610ccb576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260158152602001807f556e697377617056323a20494e56414c49445f544f000000000000000000000081525060200191505060405180910390fd5b60008b1115610ce057610cdf828a8d612a7b565b5b60008a1115610cf557610cf4818a8c612a7b565b5b6000888890501115610ddd578873ffffffffffffffffffffffffffffffffffffffff166310d1e85c338d8d8c8c6040518663ffffffff1660e01b8152600401808673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001858152602001848152602001806020018281038252848482818152602001925080828437600081840152601f19601f8201169050808301925050509650505050505050600060405180830381600087803b158015610dc457600080fd5b505af1158015610dd8573d6000803e3d6000fd5b505050505b8173ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015610e5a57600080fd5b505afa158015610e6e573d6000803e3d6000fd5b505050506040513d6020811015610e8457600080fd5b810190808051906020019092919050505093508073ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015610f1457600080fd5b505afa158015610f28573d6000803e3d6000fd5b505050506040513d6020811015610f3e57600080fd5b810190808051906020019092919050505092505050600089856dffffffffffffffffffffffffffff16038311610f75576000610f8b565b89856dffffffffffffffffffffffffffff160383035b9050600089856dffffffffffffffffffffffffffff16038311610faf576000610fc5565b89856dffffffffffffffffffffffffffff160383035b90506000821180610fd65750600081115b61102b576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260248152602001806139a16024913960400191505060405180910390fd5b6000611067611044600385612cc890919063ffffffff16565b6110596103e888612cc890919063ffffffff16565b612d5d90919063ffffffff16565b905060006110a5611082600385612cc890919063ffffffff16565b6110976103e888612cc890919063ffffffff16565b612d5d90919063ffffffff16565b90506110ef620f42406110e1896dffffffffffffffffffffffffffff168b6dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b612cc890919063ffffffff16565b6111028284612cc890919063ffffffff16565b1015611176576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f556e697377617056323a204b000000000000000000000000000000000000000081525060200191505060405180910390fd5b505061118484848888612de0565b8873ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff167fd78ad95fa46c994b6551d0da85fc275fe613ce37657fb8d5e3d130840159d82284848f8f6040518085815260200184815260200183815260200182815260200194505050505060405180910390a35050505050506001600c819055505050505050565b6040518060400160405280600a81526020017f556e69737761702056320000000000000000000000000000000000000000000081525081565b6000806000600860009054906101000a90046dffffffffffffffffffffffffffff1692506008600e9054906101000a90046dffffffffffffffffffffffffffff1691506008601c9054906101000a900463ffffffff169050909192565b60006112b933848461315e565b6001905092915050565b600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b60005481565b60007fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff600260008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054146114a45761142382600260008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054612d5d90919063ffffffff16565b600260008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055505b6114af848484613249565b600190509392505050565b7f6e71edae12b1b97f4d1f60370fef10105fa2faae0126114a169c64845d6126c960001b81565b601281565b60035481565b600560009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff16146115af576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f556e697377617056323a20464f5242494444454e00000000000000000000000081525060200191505060405180910390fd5b81600660006101000a81548173ffffffffffffffffffffffffffffffffffffffff021916908373ffffffffffffffffffffffffffffffffffffffff16021790555080600760006101000a81548173ffffffffffffffffffffffffffffffffffffffff021916908373ffffffffffffffffffffffffffffffffffffffff1602179055505050565b60095481565b600a5481565b60006001600c54146116bb576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c819055506000806116ce61124f565b50915091506000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b15801561177457600080fd5b505afa158015611788573d6000803e3d6000fd5b505050506040513d602081101561179e57600080fd5b810190808051906020019092919050505090506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b15801561185257600080fd5b505afa158015611866573d6000803e3d6000fd5b505050506040513d602081101561187c57600080fd5b8101908080519060200190929190505050905060006118b4856dffffffffffffffffffffffffffff1684612d5d90919063ffffffff16565b905060006118db856dffffffffffffffffffffffffffff1684612d5d90919063ffffffff16565b905060006118e987876133dd565b9050600080549050600081141561193d576119296103e861191b6119168688612cc890919063ffffffff16565b6135be565b612d5d90919063ffffffff16565b985061193860006103e8613620565b6119a0565b61199d886dffffffffffffffffffffffffffff166119648387612cc890919063ffffffff16565b8161196b57fe5b04886dffffffffffffffffffffffffffff166119908487612cc890919063ffffffff16565b8161199757fe5b0461373a565b98505b600089116119f9576040517f08c379a0000000000000000000000000000000000000000000000000000000008152600401808060200182810382526028815260200180613a0e6028913960400191505060405180910390fd5b611a038a8a613620565b611a0f86868a8a612de0565b8115611a8757611a806008600e9054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16600860009054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b600b819055505b3373ffffffffffffffffffffffffffffffffffffffff167f4c209b5fc8ad50758f13e2e1088ba56a560dff690a1c6fef26394f4c03821c4f8585604051808381526020018281526020019250505060405180910390a250505050505050506001600c81905550919050565b60016020528060005260406000206000915090505481565b600b5481565b60046020528060005260406000206000915090505481565b6000806001600c5414611ba3576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c81905550600080611bb661124f565b50915091506000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff16905060008273ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611c8857600080fd5b505afa158015611c9c573d6000803e3d6000fd5b505050506040513d6020811015611cb257600080fd5b8101908080519060200190929190505050905060008273ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611d4457600080fd5b505afa158015611d58573d6000803e3d6000fd5b505050506040513d6020811015611d6e57600080fd5b810190808051906020019092919050505090506000600160003073ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205490506000611dd188886133dd565b905060008054905080611ded8685612cc890919063ffffffff16565b81611df457fe5b049a5080611e0b8585612cc890919063ffffffff16565b81611e1257fe5b04995060008b118015611e25575060008a115b611e7a576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260288152602001806139e66028913960400191505060405180910390fd5b611e843084613753565b611e8f878d8d612a7b565b611e9a868d8c612a7b565b8673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611f1757600080fd5b505afa158015611f2b573d6000803e3d6000fd5b505050506040513d6020811015611f4157600080fd5b810190808051906020019092919050505094508573ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611fd157600080fd5b505afa158015611fe5573d6000803e3d6000fd5b505050506040513d6020811015611ffb57600080fd5b8101908080519060200190929190505050935061201a85858b8b612de0565b81156120925761208b6008600e9054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16600860009054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b600b819055505b8b73ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff167fdccd412f0b1252819cb1fd330b93224ca42612892bb3f4f789976e6d819364968d8d604051808381526020018281526020019250505060405180910390a35050505050505050506001600c81905550915091565b6040518060400160405280600681526020017f554e492d5632000000000000000000000000000000000000000000000000000081525081565b600061215b338484613249565b6001905092915050565b6103e881565b6001600c54146121e3576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c819055506000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506123398284612334600860009054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b1580156122eb57600080fd5b505afa1580156122ff573d6000803e3d6000fd5b505050506040513d602081101561231557600080fd5b8101908080519060200190929190505050612d5d90919063ffffffff16565b612a7b565b61243981846124346008600e9054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168573ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b1580156123eb57600080fd5b505afa1580156123ff573d6000803e3d6000fd5b505050506040513d602081101561241557600080fd5b8101908080519060200190929190505050612d5d90919063ffffffff16565b612a7b565b50506001600c8190555050565b600560009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b42841015612508576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f556e697377617056323a2045585049524544000000000000000000000000000081525060200191505060405180910390fd5b60006003547f6e71edae12b1b97f4d1f60370fef10105fa2faae0126114a169c64845d6126c960001b898989600460008e73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000206000815480929190600101919050558a604051602001808781526020018673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020018573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200184815260200183815260200182815260200196505050505050506040516020818303038152906040528051906020012060405160200180807f190100000000000000000000000000000000000000000000000000000000000081525060020183815260200182815260200192505050604051602081830303815290604052805190602001209050600060018286868660405160008152602001604052604051808581526020018460ff1660ff1681526020018381526020018281526020019450505050506020604051602081039080840390855afa1580156126da573d6000803e3d6000fd5b505050602060405103519050600073ffffffffffffffffffffffffffffffffffffffff168173ffffffffffffffffffffffffffffffffffffffff161415801561274e57508873ffffffffffffffffffffffffffffffffffffffff168173ffffffffffffffffffffffffffffffffffffffff16145b6127c0576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601c8152602001807f556e697377617056323a20494e56414c49445f5349474e41545552450000000081525060200191505060405180910390fd5b6127cb89898961315e565b505050505050505050565b6002602052816000526040600020602052806000526040600020600091509150505481565b6001600c5414612873576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c81905550612a71600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b15801561291d57600080fd5b505afa158015612931573d6000803e3d6000fd5b505050506040513d602081101561294757600080fd5b8101908080519060200190929190505050600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b1580156129f757600080fd5b505afa158015612a0b573d6000803e3d6000fd5b505050506040513d6020811015612a2157600080fd5b8101908080519060200190929190505050600860009054906101000a90046dffffffffffffffffffffffffffff166008600e9054906101000a90046dffffffffffffffffffffffffffff16612de0565b6001600c81905550565b600060608473ffffffffffffffffffffffffffffffffffffffff166040518060400160405280601981526020017f7472616e7366657228616464726573732c75696e743235362900000000000000815250805190602001208585604051602401808373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200182815260200192505050604051602081830303815290604052907bffffffffffffffffffffffffffffffffffffffffffffffffffffffff19166020820180517bffffffffffffffffffffffffffffffffffffffffffffffffffffffff83818316178352505050506040518082805190602001908083835b60208310612ba85780518252602082019150602081019050602083039250612b85565b6001836020036101000a0380198251168184511680821785525050505050509050019150506000604051808303816000865af19150503d8060008114612c0a576040519150601f19603f3d011682016040523d82523d6000602084013e612c0f565b606091505b5091509150818015612c4f5750600081511480612c4e5750808060200190516020811015612c3c57600080fd5b81019080805190602001909291905050505b5b612cc1576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601a8152602001807f556e697377617056323a205452414e534645525f4641494c454400000000000081525060200191505060405180910390fd5b5050505050565b600080821480612ce55750828283850292508281612ce257fe5b04145b612d57576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f64732d6d6174682d6d756c2d6f766572666c6f7700000000000000000000000081525060200191505060405180910390fd5b92915050565b6000828284039150811115612dda576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260158152602001807f64732d6d6174682d7375622d756e646572666c6f77000000000000000000000081525060200191505060405180910390fd5b92915050565b7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff6dffffffffffffffffffffffffffff168411158015612e5057507fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff6dffffffffffffffffffffffffffff168311155b612ec2576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260138152602001807f556e697377617056323a204f564552464c4f570000000000000000000000000081525060200191505060405180910390fd5b60006401000000004281612ed257fe5b06905060006008601c9054906101000a900463ffffffff168203905060008163ffffffff16118015612f1557506000846dffffffffffffffffffffffffffff1614155b8015612f3257506000836dffffffffffffffffffffffffffff1614155b15613014578063ffffffff16612f7785612f4b8661386d565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1661389890919063ffffffff16565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff16026009600082825401925050819055508063ffffffff16612fe584612fb98761386d565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1661389890919063ffffffff16565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1602600a600082825401925050819055505b85600860006101000a8154816dffffffffffffffffffffffffffff02191690836dffffffffffffffffffffffffffff160217905550846008600e6101000a8154816dffffffffffffffffffffffffffff02191690836dffffffffffffffffffffffffffff160217905550816008601c6101000a81548163ffffffff021916908363ffffffff1602179055507f1c411e9a96e071241c2f21f7726b17ae89e3cab4c78be50e062b03a9fffbbad1600860009054906101000a90046dffffffffffffffffffffffffffff166008600e9054906101000a90046dffffffffffffffffffffffffffff1660405180836dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168152602001826dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff1681526020019250505060405180910390a1505050505050565b80600260008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055508173ffffffffffffffffffffffffffffffffffffffff168373ffffffffffffffffffffffffffffffffffffffff167f8c5be1e5ebec7d5bd14f71427d1e84f3dd0314c0f7b2291e5b200ac8c7c3b925836040518082815260200191505060405180910390a3505050565b61329b81600160008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054612d5d90919063ffffffff16565b600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555061333081600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020546138f890919063ffffffff16565b600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055508173ffffffffffffffffffffffffffffffffffffffff168373ffffffffffffffffffffffffffffffffffffffff167fddf252ad1be2c89b69c2b068fc378daa952ba7f163c4a11628f55a4df523b3ef836040518082815260200191505060405180910390a3505050565b600080600560009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663017e7e586040518163ffffffff1660e01b815260040160206040518083038186803b15801561344857600080fd5b505afa15801561345c573d6000803e3d6000fd5b505050506040513d602081101561347257600080fd5b81019080805190602001909291905050509050600073ffffffffffffffffffffffffffffffffffffffff168173ffffffffffffffffffffffffffffffffffffffff16141591506000600b54905082156135a4576000811461359f57600061350a613505866dffffffffffffffffffffffffffff16886dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b6135be565b90506000613517836135be565b90508082111561359c57600061354a6135398385612d5d90919063ffffffff16565b600054612cc890919063ffffffff16565b9050600061357483613566600587612cc890919063ffffffff16565b6138f890919063ffffffff16565b9050600081838161358157fe5b0490506000811115613598576135978782613620565b5b5050505b50505b6135b6565b600081146135b5576000600b819055505b5b505092915050565b6000600382111561360d5781905060006001600284816135da57fe5b040190505b81811015613607578091506002818285816135f657fe5b0401816135ff57fe5b0490506135df565b5061361b565b6000821461361a57600190505b5b919050565b613635816000546138f890919063ffffffff16565b60008190555061368d81600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020546138f890919063ffffffff16565b600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055508173ffffffffffffffffffffffffffffffffffffffff16600073ffffffffffffffffffffffffffffffffffffffff167fddf252ad1be2c89b69c2b068fc378daa952ba7f163c4a11628f55a4df523b3ef836040518082815260200191505060405180910390a35050565b6000818310613749578161374b565b825b905092915050565b6137a581600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054612d5d90919063ffffffff16565b600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055506137fd81600054612d5d90919063ffffffff16565b600081905550600073ffffffffffffffffffffffffffffffffffffffff168273ffffffffffffffffffffffffffffffffffffffff167fddf252ad1be2c89b69c2b068fc378daa952ba7f163c4a11628f55a4df523b3ef836040518082815260200191505060405180910390a35050565b60006e010000000000000000000000000000826dffffffffffffffffffffffffffff16029050919050565b6000816dffffffffffffffffffffffffffff167bffffffffffffffffffffffffffffffffffffffffffffffffffffffff16837bffffffffffffffffffffffffffffffffffffffffffffffffffffffff16816138ef57fe5b04905092915050565b6000828284019150811015613975576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f64732d6d6174682d6164642d6f766572666c6f7700000000000000000000000081525060200191505060405180910390fd5b9291505056fe556e697377617056323a20494e53554646494349454e545f4f55545055545f414d4f554e54556e697377617056323a20494e53554646494349454e545f494e5055545f414d4f554e54556e697377617056323a20494e53554646494349454e545f4c4951554944495459556e697377617056323a20494e53554646494349454e545f4c49515549444954595f4255524e4544556e697377617056323a20494e53554646494349454e545f4c49515549444954595f4d494e544544a265627a7a723158201d9cc769ec1244e0335eb71f99a94869ae6ea3596ebb2c69f8185f53f440e2c664736f6c63430005100032"+uniV2Pair = fromJust $ hexByteString "608060405234801561001057600080fd5b50600436106101a95760003560e01c80636a627842116100f9578063ba9a7a5611610097578063d21220a711610071578063d21220a7146108c4578063d505accf1461090e578063dd62ed3e146109a7578063fff6cae914610a1f576101a9565b8063ba9a7a5614610818578063bc25cf7714610836578063c45a01551461087a576101a9565b80637ecebe00116100d35780637ecebe001461067857806389afcb44146106d057806395d89b411461072f578063a9059cbb146107b2576101a9565b80636a627842146105aa57806370a08231146106025780637464fc3d1461065a576101a9565b806323b872dd116101665780633644e515116101405780633644e515146104ec578063485cc9551461050a5780635909c0d51461056e5780635a3d54931461058c576101a9565b806323b872dd1461042457806330adf81f146104aa578063313ce567146104c8576101a9565b8063022c0d9f146101ae57806306fdde031461025b5780630902f1ac146102de578063095ea7b3146103565780630dfe1681146103bc57806318160ddd14610406575b600080fd5b610259600480360360808110156101c457600080fd5b810190808035906020019092919080359060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019064010000000081111561021557600080fd5b82018360208201111561022757600080fd5b8035906020019184600183028401116401000000008311171561024957600080fd5b9091929391929390505050610a29565b005b610263611216565b6040518080602001828103825283818151815260200191508051906020019080838360005b838110156102a3578082015181840152602081019050610288565b50505050905090810190601f1680156102d05780820380516001836020036101000a031916815260200191505b509250505060405180910390f35b6102e661124f565b60405180846dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168152602001836dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff1681526020018263ffffffff1663ffffffff168152602001935050505060405180910390f35b6103a26004803603604081101561036c57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506112ac565b604051808215151515815260200191505060405180910390f35b6103c46112c3565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b61040e6112e9565b6040518082815260200191505060405180910390f35b6104906004803603606081101561043a57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803590602001909291905050506112ef565b604051808215151515815260200191505060405180910390f35b6104b26114ba565b6040518082815260200191505060405180910390f35b6104d06114e1565b604051808260ff1660ff16815260200191505060405180910390f35b6104f46114e6565b6040518082815260200191505060405180910390f35b61056c6004803603604081101561052057600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506114ec565b005b610576611635565b6040518082815260200191505060405180910390f35b61059461163b565b6040518082815260200191505060405180910390f35b6105ec600480360360208110156105c057600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611641565b6040518082815260200191505060405180910390f35b6106446004803603602081101561061857600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611af2565b6040518082815260200191505060405180910390f35b610662611b0a565b6040518082815260200191505060405180910390f35b6106ba6004803603602081101561068e57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611b10565b6040518082815260200191505060405180910390f35b610712600480360360208110156106e657600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190505050611b28565b604051808381526020018281526020019250505060405180910390f35b610737612115565b6040518080602001828103825283818151815260200191508051906020019080838360005b8381101561077757808201518184015260208101905061075c565b50505050905090810190601f1680156107a45780820380516001836020036101000a031916815260200191505b509250505060405180910390f35b6107fe600480360360408110156107c857600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919050505061214e565b604051808215151515815260200191505060405180910390f35b610820612165565b6040518082815260200191505060405180910390f35b6108786004803603602081101561084c57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff16906020019092919050505061216b565b005b610882612446565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b6108cc61246c565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b6109a5600480360360e081101561092457600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291908035906020019092919080359060200190929190803560ff1690602001909291908035906020019092919080359060200190929190505050612492565b005b610a09600480360360408110156109bd57600080fd5b81019080803573ffffffffffffffffffffffffffffffffffffffff169060200190929190803573ffffffffffffffffffffffffffffffffffffffff1690602001909291905050506127d6565b6040518082815260200191505060405180910390f35b610a276127fb565b005b6001600c5414610aa1576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c819055506000851180610ab85750600084115b610b0d576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252602581526020018061397c6025913960400191505060405180910390fd5b600080610b1861124f565b5091509150816dffffffffffffffffffffffffffff1687108015610b4b5750806dffffffffffffffffffffffffffff1686105b610ba0576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260218152602001806139c56021913960400191505060405180910390fd5b6000806000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690508173ffffffffffffffffffffffffffffffffffffffff168973ffffffffffffffffffffffffffffffffffffffff1614158015610c5957508073ffffffffffffffffffffffffffffffffffffffff168973ffffffffffffffffffffffffffffffffffffffff1614155b610ccb576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260158152602001807f556e697377617056323a20494e56414c49445f544f000000000000000000000081525060200191505060405180910390fd5b60008b1115610ce057610cdf828a8d612a7b565b5b60008a1115610cf557610cf4818a8c612a7b565b5b6000888890501115610ddd578873ffffffffffffffffffffffffffffffffffffffff166310d1e85c338d8d8c8c6040518663ffffffff1660e01b8152600401808673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001858152602001848152602001806020018281038252848482818152602001925080828437600081840152601f19601f8201169050808301925050509650505050505050600060405180830381600087803b158015610dc457600080fd5b505af1158015610dd8573d6000803e3d6000fd5b505050505b8173ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015610e5a57600080fd5b505afa158015610e6e573d6000803e3d6000fd5b505050506040513d6020811015610e8457600080fd5b810190808051906020019092919050505093508073ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015610f1457600080fd5b505afa158015610f28573d6000803e3d6000fd5b505050506040513d6020811015610f3e57600080fd5b810190808051906020019092919050505092505050600089856dffffffffffffffffffffffffffff16038311610f75576000610f8b565b89856dffffffffffffffffffffffffffff160383035b9050600089856dffffffffffffffffffffffffffff16038311610faf576000610fc5565b89856dffffffffffffffffffffffffffff160383035b90506000821180610fd65750600081115b61102b576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260248152602001806139a16024913960400191505060405180910390fd5b6000611067611044600385612cc890919063ffffffff16565b6110596103e888612cc890919063ffffffff16565b612d5d90919063ffffffff16565b905060006110a5611082600385612cc890919063ffffffff16565b6110976103e888612cc890919063ffffffff16565b612d5d90919063ffffffff16565b90506110ef620f42406110e1896dffffffffffffffffffffffffffff168b6dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b612cc890919063ffffffff16565b6111028284612cc890919063ffffffff16565b1015611176576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252600c8152602001807f556e697377617056323a204b000000000000000000000000000000000000000081525060200191505060405180910390fd5b505061118484848888612de0565b8873ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff167fd78ad95fa46c994b6551d0da85fc275fe613ce37657fb8d5e3d130840159d82284848f8f6040518085815260200184815260200183815260200182815260200194505050505060405180910390a35050505050506001600c819055505050505050565b6040518060400160405280600a81526020017f556e69737761702056320000000000000000000000000000000000000000000081525081565b6000806000600860009054906101000a90046dffffffffffffffffffffffffffff1692506008600e9054906101000a90046dffffffffffffffffffffffffffff1691506008601c9054906101000a900463ffffffff169050909192565b60006112b933848461315e565b6001905092915050565b600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b60005481565b60007fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff600260008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054146114a45761142382600260008773ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054612d5d90919063ffffffff16565b600260008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055505b6114af848484613249565b600190509392505050565b7f6e71edae12b1b97f4d1f60370fef10105fa2faae0126114a169c64845d6126c960001b81565b601281565b60035481565b600560009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff16146115af576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f556e697377617056323a20464f5242494444454e00000000000000000000000081525060200191505060405180910390fd5b81600660006101000a81548173ffffffffffffffffffffffffffffffffffffffff021916908373ffffffffffffffffffffffffffffffffffffffff16021790555080600760006101000a81548173ffffffffffffffffffffffffffffffffffffffff021916908373ffffffffffffffffffffffffffffffffffffffff1602179055505050565b60095481565b600a5481565b60006001600c54146116bb576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c819055506000806116ce61124f565b50915091506000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b15801561177457600080fd5b505afa158015611788573d6000803e3d6000fd5b505050506040513d602081101561179e57600080fd5b810190808051906020019092919050505090506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b15801561185257600080fd5b505afa158015611866573d6000803e3d6000fd5b505050506040513d602081101561187c57600080fd5b8101908080519060200190929190505050905060006118b4856dffffffffffffffffffffffffffff1684612d5d90919063ffffffff16565b905060006118db856dffffffffffffffffffffffffffff1684612d5d90919063ffffffff16565b905060006118e987876133dd565b9050600080549050600081141561193d576119296103e861191b6119168688612cc890919063ffffffff16565b6135be565b612d5d90919063ffffffff16565b985061193860006103e8613620565b6119a0565b61199d886dffffffffffffffffffffffffffff166119648387612cc890919063ffffffff16565b8161196b57fe5b04886dffffffffffffffffffffffffffff166119908487612cc890919063ffffffff16565b8161199757fe5b0461373a565b98505b600089116119f9576040517f08c379a0000000000000000000000000000000000000000000000000000000008152600401808060200182810382526028815260200180613a0e6028913960400191505060405180910390fd5b611a038a8a613620565b611a0f86868a8a612de0565b8115611a8757611a806008600e9054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16600860009054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b600b819055505b3373ffffffffffffffffffffffffffffffffffffffff167f4c209b5fc8ad50758f13e2e1088ba56a560dff690a1c6fef26394f4c03821c4f8585604051808381526020018281526020019250505060405180910390a250505050505050506001600c81905550919050565b60016020528060005260406000206000915090505481565b600b5481565b60046020528060005260406000206000915090505481565b6000806001600c5414611ba3576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c81905550600080611bb661124f565b50915091506000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff16905060008273ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611c8857600080fd5b505afa158015611c9c573d6000803e3d6000fd5b505050506040513d6020811015611cb257600080fd5b8101908080519060200190929190505050905060008273ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611d4457600080fd5b505afa158015611d58573d6000803e3d6000fd5b505050506040513d6020811015611d6e57600080fd5b810190808051906020019092919050505090506000600160003073ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000205490506000611dd188886133dd565b905060008054905080611ded8685612cc890919063ffffffff16565b81611df457fe5b049a5080611e0b8585612cc890919063ffffffff16565b81611e1257fe5b04995060008b118015611e25575060008a115b611e7a576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260288152602001806139e66028913960400191505060405180910390fd5b611e843084613753565b611e8f878d8d612a7b565b611e9a868d8c612a7b565b8673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611f1757600080fd5b505afa158015611f2b573d6000803e3d6000fd5b505050506040513d6020811015611f4157600080fd5b810190808051906020019092919050505094508573ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b158015611fd157600080fd5b505afa158015611fe5573d6000803e3d6000fd5b505050506040513d6020811015611ffb57600080fd5b8101908080519060200190929190505050935061201a85858b8b612de0565b81156120925761208b6008600e9054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16600860009054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b600b819055505b8b73ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff167fdccd412f0b1252819cb1fd330b93224ca42612892bb3f4f789976e6d819364968d8d604051808381526020018281526020019250505060405180910390a35050505050505050506001600c81905550915091565b6040518060400160405280600681526020017f554e492d5632000000000000000000000000000000000000000000000000000081525081565b600061215b338484613249565b6001905092915050565b6103e881565b6001600c54146121e3576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c819055506000600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506000600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1690506123398284612334600860009054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b1580156122eb57600080fd5b505afa1580156122ff573d6000803e3d6000fd5b505050506040513d602081101561231557600080fd5b8101908080519060200190929190505050612d5d90919063ffffffff16565b612a7b565b61243981846124346008600e9054906101000a90046dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168573ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b1580156123eb57600080fd5b505afa1580156123ff573d6000803e3d6000fd5b505050506040513d602081101561241557600080fd5b8101908080519060200190929190505050612d5d90919063ffffffff16565b612a7b565b50506001600c8190555050565b600560009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b42841015612508576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260128152602001807f556e697377617056323a2045585049524544000000000000000000000000000081525060200191505060405180910390fd5b60006003547f6e71edae12b1b97f4d1f60370fef10105fa2faae0126114a169c64845d6126c960001b898989600460008e73ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000206000815480929190600101919050558a604051602001808781526020018673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020018573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200184815260200183815260200182815260200196505050505050506040516020818303038152906040528051906020012060405160200180807f190100000000000000000000000000000000000000000000000000000000000081525060020183815260200182815260200192505050604051602081830303815290604052805190602001209050600060018286868660405160008152602001604052604051808581526020018460ff1660ff1681526020018381526020018281526020019450505050506020604051602081039080840390855afa1580156126da573d6000803e3d6000fd5b505050602060405103519050600073ffffffffffffffffffffffffffffffffffffffff168173ffffffffffffffffffffffffffffffffffffffff161415801561274e57508873ffffffffffffffffffffffffffffffffffffffff168173ffffffffffffffffffffffffffffffffffffffff16145b6127c0576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601c8152602001807f556e697377617056323a20494e56414c49445f5349474e41545552450000000081525060200191505060405180910390fd5b6127cb89898961315e565b505050505050505050565b6002602052816000526040600020602052806000526040600020600091509150505481565b6001600c5414612873576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260118152602001807f556e697377617056323a204c4f434b454400000000000000000000000000000081525060200191505060405180910390fd5b6000600c81905550612a71600660009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b15801561291d57600080fd5b505afa158015612931573d6000803e3d6000fd5b505050506040513d602081101561294757600080fd5b8101908080519060200190929190505050600760009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff166370a08231306040518263ffffffff1660e01b8152600401808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060206040518083038186803b1580156129f757600080fd5b505afa158015612a0b573d6000803e3d6000fd5b505050506040513d6020811015612a2157600080fd5b8101908080519060200190929190505050600860009054906101000a90046dffffffffffffffffffffffffffff166008600e9054906101000a90046dffffffffffffffffffffffffffff16612de0565b6001600c81905550565b600060608473ffffffffffffffffffffffffffffffffffffffff166040518060400160405280601981526020017f7472616e7366657228616464726573732c75696e743235362900000000000000815250805190602001208585604051602401808373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200182815260200192505050604051602081830303815290604052907bffffffffffffffffffffffffffffffffffffffffffffffffffffffff19166020820180517bffffffffffffffffffffffffffffffffffffffffffffffffffffffff83818316178352505050506040518082805190602001908083835b60208310612ba85780518252602082019150602081019050602083039250612b85565b6001836020036101000a0380198251168184511680821785525050505050509050019150506000604051808303816000865af19150503d8060008114612c0a576040519150601f19603f3d011682016040523d82523d6000602084013e612c0f565b606091505b5091509150818015612c4f5750600081511480612c4e5750808060200190516020811015612c3c57600080fd5b81019080805190602001909291905050505b5b612cc1576040517f08c379a000000000000000000000000000000000000000000000000000000000815260040180806020018281038252601a8152602001807f556e697377617056323a205452414e534645525f4641494c454400000000000081525060200191505060405180910390fd5b5050505050565b600080821480612ce55750828283850292508281612ce257fe5b04145b612d57576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f64732d6d6174682d6d756c2d6f766572666c6f7700000000000000000000000081525060200191505060405180910390fd5b92915050565b6000828284039150811115612dda576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260158152602001807f64732d6d6174682d7375622d756e646572666c6f77000000000000000000000081525060200191505060405180910390fd5b92915050565b7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff6dffffffffffffffffffffffffffff168411158015612e5057507fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff6dffffffffffffffffffffffffffff168311155b612ec2576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260138152602001807f556e697377617056323a204f564552464c4f570000000000000000000000000081525060200191505060405180910390fd5b60006401000000004281612ed257fe5b06905060006008601c9054906101000a900463ffffffff168203905060008163ffffffff16118015612f1557506000846dffffffffffffffffffffffffffff1614155b8015612f3257506000836dffffffffffffffffffffffffffff1614155b15613014578063ffffffff16612f7785612f4b8661386d565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1661389890919063ffffffff16565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff16026009600082825401925050819055508063ffffffff16612fe584612fb98761386d565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1661389890919063ffffffff16565b7bffffffffffffffffffffffffffffffffffffffffffffffffffffffff1602600a600082825401925050819055505b85600860006101000a8154816dffffffffffffffffffffffffffff02191690836dffffffffffffffffffffffffffff160217905550846008600e6101000a8154816dffffffffffffffffffffffffffff02191690836dffffffffffffffffffffffffffff160217905550816008601c6101000a81548163ffffffff021916908363ffffffff1602179055507f1c411e9a96e071241c2f21f7726b17ae89e3cab4c78be50e062b03a9fffbbad1600860009054906101000a90046dffffffffffffffffffffffffffff166008600e9054906101000a90046dffffffffffffffffffffffffffff1660405180836dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff168152602001826dffffffffffffffffffffffffffff166dffffffffffffffffffffffffffff1681526020019250505060405180910390a1505050505050565b80600260008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055508173ffffffffffffffffffffffffffffffffffffffff168373ffffffffffffffffffffffffffffffffffffffff167f8c5be1e5ebec7d5bd14f71427d1e84f3dd0314c0f7b2291e5b200ac8c7c3b925836040518082815260200191505060405180910390a3505050565b61329b81600160008673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054612d5d90919063ffffffff16565b600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000208190555061333081600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020546138f890919063ffffffff16565b600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055508173ffffffffffffffffffffffffffffffffffffffff168373ffffffffffffffffffffffffffffffffffffffff167fddf252ad1be2c89b69c2b068fc378daa952ba7f163c4a11628f55a4df523b3ef836040518082815260200191505060405180910390a3505050565b600080600560009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663017e7e586040518163ffffffff1660e01b815260040160206040518083038186803b15801561344857600080fd5b505afa15801561345c573d6000803e3d6000fd5b505050506040513d602081101561347257600080fd5b81019080805190602001909291905050509050600073ffffffffffffffffffffffffffffffffffffffff168173ffffffffffffffffffffffffffffffffffffffff16141591506000600b54905082156135a4576000811461359f57600061350a613505866dffffffffffffffffffffffffffff16886dffffffffffffffffffffffffffff16612cc890919063ffffffff16565b6135be565b90506000613517836135be565b90508082111561359c57600061354a6135398385612d5d90919063ffffffff16565b600054612cc890919063ffffffff16565b9050600061357483613566600587612cc890919063ffffffff16565b6138f890919063ffffffff16565b9050600081838161358157fe5b0490506000811115613598576135978782613620565b5b5050505b50505b6135b6565b600081146135b5576000600b819055505b5b505092915050565b6000600382111561360d5781905060006001600284816135da57fe5b040190505b81811015613607578091506002818285816135f657fe5b0401816135ff57fe5b0490506135df565b5061361b565b6000821461361a57600190505b5b919050565b613635816000546138f890919063ffffffff16565b60008190555061368d81600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020546138f890919063ffffffff16565b600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055508173ffffffffffffffffffffffffffffffffffffffff16600073ffffffffffffffffffffffffffffffffffffffff167fddf252ad1be2c89b69c2b068fc378daa952ba7f163c4a11628f55a4df523b3ef836040518082815260200191505060405180910390a35050565b6000818310613749578161374b565b825b905092915050565b6137a581600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002054612d5d90919063ffffffff16565b600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020819055506137fd81600054612d5d90919063ffffffff16565b600081905550600073ffffffffffffffffffffffffffffffffffffffff168273ffffffffffffffffffffffffffffffffffffffff167fddf252ad1be2c89b69c2b068fc378daa952ba7f163c4a11628f55a4df523b3ef836040518082815260200191505060405180910390a35050565b60006e010000000000000000000000000000826dffffffffffffffffffffffffffff16029050919050565b6000816dffffffffffffffffffffffffffff167bffffffffffffffffffffffffffffffffffffffffffffffffffffffff16837bffffffffffffffffffffffffffffffffffffffffffffffffffffffff16816138ef57fe5b04905092915050565b6000828284019150811015613975576040517f08c379a00000000000000000000000000000000000000000000000000000000081526004018080602001828103825260148152602001807f64732d6d6174682d6164642d6f766572666c6f7700000000000000000000000081525060200191505060405180910390fd5b9291505056fe556e697377617056323a20494e53554646494349454e545f4f55545055545f414d4f554e54556e697377617056323a20494e53554646494349454e545f494e5055545f414d4f554e54556e697377617056323a20494e53554646494349454e545f4c4951554944495459556e697377617056323a20494e53554646494349454e545f4c49515549444954595f4255524e4544556e697377617056323a20494e53554646494349454e545f4c49515549444954595f4d494e544544a265627a7a723158201d9cc769ec1244e0335eb71f99a94869ae6ea3596ebb2c69f8185f53f440e2c664736f6c63430005100032"

cli/cli.hs view

@@ -12,7 +12,7 @@ import Data.ByteString (ByteString) import Data.DoubleWord (Word256) import Data.List (intersperse)-import Data.Maybe (fromMaybe, mapMaybe, fromJust)+import Data.Maybe (fromMaybe, mapMaybe, fromJust, isNothing) import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Version (showVersion)@@ -26,6 +26,7 @@ import System.Directory (withCurrentDirectory, getCurrentDirectory, doesDirectoryExist, makeAbsolute) import System.FilePath ((</>)) import System.Exit (exitFailure, exitWith, ExitCode(..))+import Main.Utf8 (withUtf8)  import EVM (initialContract, abstractContract, makeVm) import EVM.ABI (Sig(..))@@ -46,6 +47,9 @@ import EVM.UnitTest import EVM.Effects +data AssertionType = DSTest | Forge+  deriving (Eq, Show, Read, ParseField)+ -- This record defines the program's command-line options -- automatically via the `optparse-generic` package. data Command w@@ -76,7 +80,8 @@    -- symbolic execution opts       , root          :: w ::: Maybe String       <?> "Path to  project root directory (default: . )"-      , projectType   :: w ::: Maybe ProjectType  <?> "Is this a Foundry or DappTools project (default: Foundry)"+      , projectType   :: w ::: Maybe ProjectType  <?> "Is this a CombinedJSON or Foundry project (default: Foundry)"+      , assertionType :: w ::: Maybe AssertionType <?> "Assertions as per Forge or DSTest (default: Forge)"       , initialStorage :: w ::: Maybe (InitialStorage) <?> "Starting state for storage: Empty, Abstract (default Abstract)"       , sig           :: w ::: Maybe Text         <?> "Signature of types to decode / encode"       , arg           :: w ::: [String]           <?> "Values to encode"@@ -84,18 +89,18 @@       , showTree      :: w ::: Bool               <?> "Print branches explored in tree view"       , showReachableTree :: w ::: Bool           <?> "Print only reachable branches explored in tree view"       , smttimeout    :: w ::: Maybe Natural      <?> "Timeout given to SMT solver in seconds (default: 300)"-      , maxIterations :: w ::: Maybe Integer      <?> "Number of times we may revisit a particular branching point"+      , maxIterations :: w ::: Maybe Integer      <?> "Number of times we may revisit a particular branching point. For no bound, set -1 (default: 5)"       , solver        :: w ::: Maybe Text         <?> "Used SMT solver: z3 (default), cvc5, or bitwuzla"       , smtdebug      :: w ::: Bool               <?> "Print smt queries sent to the solver"-      , debug         :: w ::: Bool               <?> "Debug printing of internal behaviour"+      , debug         :: w ::: Bool               <?> "Debug printing of internal behaviour, and dump internal expressions"       , trace         :: w ::: Bool               <?> "Dump trace"       , assertions    :: w ::: Maybe [Word256]    <?> "Comma separated list of solc panic codes to check for (default: user defined assertion violations only)"       , askSmtIterations :: w ::: Integer         <!> "1" <?> "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 1)"       , numCexFuzz    :: w ::: Integer            <!> "3" <?> "Number of fuzzing tries to do to generate a counterexample (default: 3)"       , numSolvers    :: w ::: Maybe Natural      <?> "Number of solver instances to use (default: number of cpu cores)"+      , solverThreads :: w ::: Maybe Natural      <?> "Number of threads for each solver instance. Only respected for Z3 (default: 1)"       , loopDetectionHeuristic :: w ::: LoopHeuristic <!> "StackBased" <?> "Which heuristic should be used to determine if we are in a loop: StackBased (default) or Naive"-      , abstractArithmetic    :: w ::: Bool             <?> "Use abstraction-refinement for complicated arithmetic functions such as MulMod. This runs the solver first with abstraction turned on, and if it returns a potential counterexample, the counterexample is refined to make sure it is a counterexample for the actual (not the abstracted) problem"-      , abstractMemory    :: w ::: Bool                      <?> "Use abstraction-refinement for Memory. This runs the solver first with abstraction turned on, and if it returns a potential counterexample, the counterexample is refined to make sure it is a counterexample for the actual (not the abstracted) problem"+      , noDecompose   :: w ::: Bool               <?> "Don't decompose storage slots into separate arrays"       }   | Equivalence -- prove equivalence between two programs       { codeA         :: w ::: ByteString       <?> "Bytecode of the first program"@@ -104,17 +109,18 @@       , arg           :: w ::: [String]         <?> "Values to encode"       , calldata      :: w ::: Maybe ByteString <?> "Tx: calldata"       , smttimeout    :: w ::: Maybe Natural    <?> "Timeout given to SMT solver in seconds (default: 300)"-      , maxIterations :: w ::: Maybe Integer    <?> "Number of times we may revisit a particular branching point"+      , maxIterations :: w ::: Maybe Integer    <?> "Number of times we may revisit a particular branching point. For no bound, set -1 (default: 5)"       , solver        :: w ::: Maybe Text       <?> "Used SMT solver: z3 (default), cvc5, or bitwuzla"       , smtoutput     :: w ::: Bool             <?> "Print verbose smt output"       , smtdebug      :: w ::: Bool             <?> "Print smt queries sent to the solver"-      , debug         :: w ::: Bool             <?> "Debug printing of internal behaviour"+      , debug         :: w ::: Bool             <?> "Debug printing of internal behaviour, and dump internal expressions"       , trace         :: w ::: Bool             <?> "Dump trace"       , askSmtIterations :: w ::: Integer       <!> "1" <?> "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 1)"       , numCexFuzz    :: w ::: Integer          <!> "3" <?> "Number of fuzzing tries to do to generate a counterexample (default: 3)"+      , numSolvers    :: w ::: Maybe Natural    <?> "Number of solver instances to use (default: number of cpu cores)"+      , solverThreads :: w ::: Maybe Natural    <?> "Number of threads for each solver instance. Only respected for Z3 (default: 1)"       , loopDetectionHeuristic :: w ::: LoopHeuristic <!> "StackBased" <?> "Which heuristic should be used to determine if we are in a loop: StackBased (default) or Naive"-      , abstractArithmetic    :: w ::: Bool             <?> "Use abstraction-refinement for complicated arithmetic functions such as MulMod. This runs the solver first with abstraction turned on, and if it returns a potential counterexample, the counterexample is refined to make sure it is a counterexample for the actual (not the abstracted) problem"-      , abstractMemory    :: w ::: Bool                      <?> "Use abstraction-refinement for Memory. This runs the solver first with abstraction turned on, and if it returns a potential counterexample, the counterexample is refined to make sure it is a counterexample for the actual (not the abstracted) problem"+      , noDecompose   :: w ::: Bool             <?> "Don't decompose storage slots into separate arrays"       }   | Exec -- Execute a given program with specified env & calldata       { code        :: w ::: Maybe ByteString  <?> "Program bytecode"@@ -136,16 +142,18 @@       , maxcodesize :: w ::: Maybe W256        <?> "Block: max code size"       , prevRandao  :: w ::: Maybe W256        <?> "Block: prevRandao"       , chainid     :: w ::: Maybe W256        <?> "Env: chainId"-      , debug       :: w ::: Bool              <?> "Debug printing of internal behaviour"+      , debug         :: w ::: Bool            <?> "Debug printing of internal behaviour, and dump internal expressions"       , trace       :: w ::: Bool              <?> "Dump trace"       , rpc         :: w ::: Maybe URL         <?> "Fetch state from a remote node"       , block       :: w ::: Maybe W256        <?> "Block state is be fetched from"       , root        :: w ::: Maybe String      <?> "Path to  project root directory (default: . )"-      , projectType :: w ::: Maybe ProjectType <?> "Is this a Foundry or DappTools project (default: Foundry)"+      , projectType :: w ::: Maybe ProjectType <?> "Is this a CombinedJSON or Foundry project (default: Foundry)"+      , assertionType :: w ::: Maybe AssertionType <?> "Assertions as per Forge or DSTest (default: Forge)"       }-  | Test -- Run DSTest unit tests+  | Test -- Run Foundry unit tests       { root        :: w ::: Maybe String               <?> "Path to  project root directory (default: . )"-      , projectType   :: w ::: Maybe ProjectType        <?> "Is this a Foundry or DappTools project (default: Foundry)"+      , projectType   :: w ::: Maybe ProjectType        <?> "Is this a CombinedJSON or Foundry project (default: Foundry)"+      , assertionType :: w ::: Maybe AssertionType <?> "Assertions as per Forge or DSTest (default: Forge)"       , rpc           :: w ::: Maybe URL                <?> "Fetch state from a remote node"       , number        :: w ::: Maybe W256               <?> "Block: number"       , verbose       :: w ::: Maybe Int                <?> "Append call trace: {1} failures {2} all"@@ -153,15 +161,15 @@       , match         :: w ::: Maybe String             <?> "Test case filter - only run methods matching regex"       , solver        :: w ::: Maybe Text               <?> "Used SMT solver: z3 (default), cvc5, or bitwuzla"       , numSolvers    :: w ::: Maybe Natural            <?> "Number of solver instances to use (default: number of cpu cores)"+      , solverThreads :: w ::: Maybe Natural            <?> "Number of threads for each solver instance. Only respected for Z3 (default: 1)"       , smtdebug      :: w ::: Bool                     <?> "Print smt queries sent to the solver"-      , debug         :: w ::: Bool                     <?> "Debug printing of internal behaviour"+      , debug         :: w ::: Bool                     <?> "Debug printing of internal behaviour, and dump internal expressions"       , trace         :: w ::: Bool                     <?> "Dump trace"       , ffi           :: w ::: Bool                     <?> "Allow the usage of the hevm.ffi() cheatcode (WARNING: this allows test authors to execute arbitrary code on your machine)"       , smttimeout    :: w ::: Maybe Natural            <?> "Timeout given to SMT solver in seconds (default: 300)"-      , maxIterations :: w ::: Maybe Integer            <?> "Number of times we may revisit a particular branching point"+      , maxIterations :: w ::: Maybe Integer            <?> "Number of times we may revisit a particular branching point. For no bound, set -1 (default: 5)"       , loopDetectionHeuristic :: w ::: LoopHeuristic   <!> "StackBased" <?> "Which heuristic should be used to determine if we are in a loop: StackBased (default) or Naive"-      , abstractArithmetic    :: w ::: Bool             <?> "Use abstraction-refinement for complicated arithmetic functions such as MulMod. This runs the solver first with abstraction turned on, and if it returns a potential counterexample, the counterexample is refined to make sure it is a counterexample for the actual (not the abstracted) problem"-      , abstractMemory    :: w ::: Bool                      <?> "Use abstraction-refinement for Memory. This runs the solver first with abstraction turned on, and if it returns a potential counterexample, the counterexample is refined to make sure it is a counterexample for the actual (not the abstracted) problem"+      , noDecompose   :: w ::: Bool                     <?> "Don't decompose storage slots into separate arrays"       , numCexFuzz    :: w ::: Integer                  <!> "3" <?> "Number of fuzzing tries to do to generate a counterexample (default: 3)"       , askSmtIterations :: w ::: Integer               <!> "1" <?> "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 1)"       }@@ -197,15 +205,15 @@       Left _ -> "no git revision present"  main :: IO ()-main = do+main = withUtf8 $ do   cmd <- Options.unwrapRecord "hevm -- Ethereum evaluator"   let env = Env { config = defaultConfig     { dumpQueries = cmd.smtdebug     , debug = cmd.debug+    , dumpExprs = cmd.debug     , numCexFuzz = cmd.numCexFuzz-    , abstRefineMem = cmd.abstractMemory-    , abstRefineArith = cmd.abstractArithmetic     , dumpTrace = cmd.trace+    , decomposeStorage = Prelude.not cmd.noDecompose     } }   case cmd of     Version {} ->putStrLn getFullVersion@@ -219,8 +227,8 @@       solver <- getSolver cmd       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)+      runEnv env $ withSolvers solver solverCount (fromMaybe 1 cmd.solverThreads) cmd.smttimeout $ \solvers -> do+        buildOut <- readBuildOutput root (getProjectType cmd)         case buildOut of           Left e -> liftIO $ do             putStrLn $ "Error: " <> e@@ -233,31 +241,44 @@  equivalence :: App m => Command Options.Unwrapped -> m () equivalence cmd = do-  let bytecodeA = hexByteString "--code" . strip0x $ cmd.codeA-      bytecodeB = hexByteString "--code" . strip0x $ cmd.codeB-      veriOpts = VeriOpts { simp = True-                          , maxIter = cmd.maxIterations-                          , askSmtIters = cmd.askSmtIterations-                          , loopHeuristic = cmd.loopDetectionHeuristic-                          , rpcInfo = Nothing-                          }-  calldata <- liftIO $ buildCalldata cmd-  solver <- liftIO $ getSolver cmd-  withSolvers solver 3 Nothing $ \s -> do-    res <- equivalenceCheck s bytecodeA bytecodeB veriOpts calldata-    case any isCex res of-      False -> liftIO $ do-        putStrLn "No discrepancies found"-        when (any isTimeout res) $ do-          putStrLn "But timeout(s) occurred"+  let bytecodeA' = hexByteString $ strip0x cmd.codeA+      bytecodeB' = hexByteString $ strip0x cmd.codeB+  if (isNothing bytecodeA') then liftIO $ do+    putStrLn $ "Error, invalid bytecode for program A: " <> show cmd.codeA+    exitFailure+  else if (isNothing bytecodeB') then liftIO $ do+    putStrLn $ "Error, invalid bytecode for program B: " <> show cmd.codeB+    exitFailure+  else do+    let bytecodeA = fromJust bytecodeA'+        bytecodeB = fromJust bytecodeB'+        veriOpts = VeriOpts { simp = True+                            , maxIter = parseMaxIters cmd.maxIterations+                            , askSmtIters = cmd.askSmtIterations+                            , loopHeuristic = cmd.loopDetectionHeuristic+                            , rpcInfo = Nothing+                            }+    calldata <- liftIO $ buildCalldata cmd+    solver <- liftIO $ getSolver cmd+    cores <- liftIO $ unsafeInto <$> getNumProcessors+    let solverCount = fromMaybe cores cmd.numSolvers+    withSolvers solver solverCount (fromMaybe 1 cmd.solverThreads) cmd.smttimeout $ \s -> do+      res <- equivalenceCheck s bytecodeA bytecodeB veriOpts calldata+      case any isCex res of+        False -> liftIO $ do+          putStrLn "No discrepancies found"+          when (any isUnknown res || any isError res) $ do+            putStrLn "But the following issues occurred:"+            forM_ (groupIssues (filter isError res)) $ \(num, str) -> putStrLn $ "      " <> show num <> "x -> " <> str+            forM_ (groupIssues (filter isUnknown res)) $ \(num, str) -> putStrLn $ "      " <> show num <> "x -> " <> str+            exitFailure+        True -> liftIO $ do+          let cexs = mapMaybe getCex res+          T.putStrLn . T.unlines $+            [ "Not equivalent. The following inputs result in differing behaviours:"+            , "" , "-----", ""+            ] <> (intersperse (T.unlines [ "", "-----" ]) $ fmap (formatCex (AbstractBuf "txdata") Nothing) cexs)           exitFailure-      True -> liftIO $ do-        let cexs = mapMaybe getCex res-        T.putStrLn . T.unlines $-          [ "Not equivalent. The following inputs result in differing behaviours:"-          , "" , "-----", ""-          ] <> (intersperse (T.unlines [ "", "-----" ]) $ fmap (formatCex (AbstractBuf "txdata") Nothing) cexs)-        exitFailure  getSolver :: Command Options.Unwrapped -> IO Solver getSolver cmd = case cmd.solver of@@ -270,14 +291,15 @@                                 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@@ -289,6 +311,10 @@ getRoot :: Command Options.Unwrapped -> IO FilePath getRoot cmd = maybe getCurrentDirectory makeAbsolute (cmd.root) +parseMaxIters :: Maybe Integer -> Maybe Integer+parseMaxIters i = if num < 0 then Nothing else Just num+  where+    num = fromMaybe (5::Integer) i  -- | Builds a buffer representing calldata based on the given cli arguments buildCalldata :: Command Options.Unwrapped -> IO (Expr Buf, [Prop])@@ -296,7 +322,12 @@   -- fully abstract calldata   (Nothing, Nothing) -> pure $ mkCalldata Nothing []   -- fully concrete calldata-  (Just c, Nothing) -> pure (ConcreteBuf (hexByteString "bytes" . strip0x $ c), [])+  (Just c, Nothing) -> do+    let val = hexByteString $ strip0x c+    if (isNothing val) then do+      putStrLn $ "Error, invalid calldata: " <>  show c+      exitFailure+    else pure (ConcreteBuf (fromJust val), [])   -- calldata according to given abi with possible specializations from the `arg` list   (Nothing, Just sig') -> do     method' <- functionAbi sig'@@ -318,38 +349,38 @@   cores <- liftIO $ unsafeInto <$> getNumProcessors   let solverCount = fromMaybe cores cmd.numSolvers   solver <- liftIO $ getSolver cmd-  withSolvers solver solverCount cmd.smttimeout $ \solvers -> do-    let opts = VeriOpts { simp = True-                        , maxIter = cmd.maxIterations+  withSolvers solver solverCount (fromMaybe 1 cmd.solverThreads) cmd.smttimeout $ \solvers -> do+    let veriOpts = VeriOpts { simp = True+                        , maxIter = parseMaxIters cmd.maxIterations                         , askSmtIters = cmd.askSmtIterations                         , loopHeuristic = cmd.loopDetectionHeuristic                         , rpcInfo = rpcinfo     }-    (expr, res) <- verify solvers opts preState (Just $ checkAssertions errCodes)+    (expr, res) <- verify solvers veriOpts preState (Just $ checkAssertions errCodes)     case res of       [Qed _] -> do         liftIO $ putStrLn "\nQED: No reachable property violations discovered\n"         showExtras solvers cmd calldata expr       _ -> do         let cexs = snd <$> mapMaybe getCex res-            timeouts = mapMaybe getTimeout res+            smtUnknowns = mapMaybe getUnknown res             counterexamples               | null cexs = []               | otherwise =                  [ ""-                 , "Discovered the following counterexamples:"+                 , ("Discovered the following " <> (T.pack $ show (length cexs)) <> " counterexample(s):")                  , ""                  ] <> fmap (formatCex (fst calldata) Nothing) cexs             unknowns-              | null timeouts = []+              | null smtUnknowns = []               | otherwise =                  [ ""-                 , "Could not determine reachability of the following end states:"+                 , "Could not determine reachability of the following end state(s):"                  , ""-                 ] <> fmap (formatExpr) timeouts+                 ] <> fmap (formatExpr) smtUnknowns         liftIO $ T.putStrLn $ T.unlines (counterexamples <> unknowns)         showExtras solvers cmd calldata expr-        liftIO $ exitFailure+        liftIO exitFailure  showExtras :: App m => SolverGroup -> Command Options.Unwrapped -> (Expr Buf, [Prop]) -> Expr End -> m () showExtras solvers cmd calldata expr = do@@ -364,7 +395,7 @@       T.putStrLn (formatExpr . snd $ reached)       putStrLn ""   when cmd.getModels $ do-    liftIO $ putStrLn $ "=== Models for " <> show (Expr.numBranches expr) <> " branches ===\n"+    liftIO $ putStrLn $ "=== Models for " <> show (Expr.numBranches expr) <> " branches ==="     ms <- produceModels solvers expr     liftIO $ forM_ ms (showModel (fst calldata)) @@ -376,14 +407,14 @@  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     rpcinfo = (,) block <$> cmd.rpc    -- TODO: we shouldn't need solvers to execute this code-  withSolvers Z3 0 Nothing $ \solvers -> do+  withSolvers Z3 0 1 Nothing $ \solvers -> do     vm' <- EVM.Stepper.interpret (Fetch.oracle solvers rpcinfo) vm EVM.Stepper.runFully     writeTraceDapp dapp vm'     case vm'.result of@@ -410,7 +441,9 @@   (miner,ts,baseFee,blockNum,prevRan) <- case cmd.rpc of     Nothing -> pure (LitAddr 0,Lit 0,0,0,0)     Just url -> Fetch.fetchBlockFrom block url >>= \case-      Nothing -> error "Error: Could not fetch block"+      Nothing -> do+        putStrLn $ "Error, Could not fetch block" <> show block <> " from URL: " <> show url+        exitFailure       Just Block{..} -> pure ( coinbase                              , timestamp                              , baseFee@@ -420,44 +453,60 @@    contract <- case (cmd.rpc, cmd.address, cmd.code) of     (Just url, Just addr', Just c) -> do-      Fetch.fetchContractFrom block url addr' >>= \case-        Nothing ->-          error $ "Error: contract not found: " <> show address-        Just contract ->-          -- if both code and url is given,-          -- fetch the contract and overwrite the code-          pure $-            initialContract  (mkCode $ hexByteString "--code" $ strip0x c)-              & set #balance  (contract.balance)-              & set #nonce    (contract.nonce)-              & set #external (contract.external)+      let code = hexByteString $ strip0x c+      if (isNothing code) then do+        putStrLn $ "Error, invalid code: " <> show c+        exitFailure+      else+        Fetch.fetchContractFrom block url addr' >>= \case+          Nothing -> do+            putStrLn $ "Error: contract not found: " <> show address+            exitFailure+          Just contract ->+            -- if both code and url is given,+            -- fetch the contract and overwrite the code+            pure $+              initialContract  (mkCode $ fromJust code)+                & set #balance  (contract.balance)+                & set #nonce    (contract.nonce)+                & set #external (contract.external)      (Just url, Just addr', Nothing) ->       Fetch.fetchContractFrom block url addr' >>= \case-        Nothing ->-          error $ "Error: contract not found: " <> show address+        Nothing -> do+          putStrLn $ "Error, contract not found: " <> show address+          exitFailure         Just contract -> pure contract -    (_, _, Just c)  ->-      pure $-        initialContract (mkCode $ hexByteString "--code" $ strip0x c)+    (_, _, Just c)  -> do+      let code = hexByteString $ strip0x c+      if (isNothing code) then do+        putStrLn $ "Error, invalid code: " <> show c+        exitFailure+      else pure $ initialContract (mkCode $ fromJust code) -    (_, _, Nothing) ->-      error "Error: must provide at least (rpc + address) or code"+    (_, _, Nothing) -> do+      putStrLn "Error, must provide at least (rpc + address) or code"+      exitFailure    let ts' = case maybeLitWord ts of         Just t -> t         Nothing -> internalError "unexpected symbolic timestamp when executing vm test" -  vm <- stToIO $ vm0 baseFee miner ts' blockNum prevRan contract-  pure $ EVM.Transaction.initTx vm-    where+  if (isNothing bsCallData) then do+    putStrLn $ "Error, invalid calldata: " <> show calldata+    exitFailure+  else do+    vm <- stToIO $ vm0 baseFee miner ts' blockNum prevRan contract+    pure $ EVM.Transaction.initTx vm+  where+        bsCallData = bytes (.calldata) (pure "")         block   = maybe Fetch.Latest Fetch.BlockNumber cmd.block         value   = word (.value) 0         caller  = addr (.caller) (LitAddr 0)         origin  = addr (.origin) (LitAddr 0)-        calldata = ConcreteBuf $ bytes (.calldata) ""-        decipher = hexByteString "bytes" . strip0x+        calldata = ConcreteBuf $ fromJust bsCallData+        decipher = hexByteString . strip0x         mkCode bs = if cmd.create                     then InitCode bs mempty                     else RuntimeCode (ConcreteRuntimeCode bs)@@ -490,6 +539,8 @@           , baseState      = EmptyBase           , txAccessList   = mempty -- TODO: support me soon           , allowFFI       = False+          , freshAddresses = 0+          , beaconRoot     = 0           }         word f def = fromMaybe def (f cmd)         word64 f def = fromMaybe def (f cmd)@@ -501,7 +552,9 @@   (miner,blockNum,baseFee,prevRan) <- case cmd.rpc of     Nothing -> pure (SymAddr "miner",0,0,0)     Just url -> Fetch.fetchBlockFrom block url >>= \case-      Nothing -> error "Error: Could not fetch block"+      Nothing -> do+        putStrLn $ "Error, Could not fetch block" <> show block <> " from URL: " <> show url+        exitFailure       Just Block{..} -> pure ( coinbase                              , number                              , baseFee@@ -509,44 +562,58 @@                              )    let-    caller = SymAddr "caller"+    caller = maybe (SymAddr "caller") LitAddr cmd.caller     ts = maybe Timestamp Lit cmd.timestamp     callvalue = maybe TxValue Lit cmd.value+    storageBase = maybe AbstractBase parseInitialStorage (cmd.initialStorage)    contract <- case (cmd.rpc, cmd.address, cmd.code) of     (Just url, Just addr', _) ->       Fetch.fetchContractFrom block url addr' >>= \case-        Nothing ->-          error "Error: contract not found."-        Just contract' -> pure contract''-          where-            contract'' = case cmd.code of-              Nothing -> contract'+        Nothing -> do+          putStrLn "Error, contract not found."+          exitFailure+        Just contract' -> case cmd.code of+              Nothing -> pure contract'               -- if both code and url is given,               -- fetch the contract and overwrite the code-              Just c -> initialContract (mkCode $ decipher c)+              Just c -> do+                let c' = decipher c+                if (isNothing c') then do+                  putStrLn $ "Error, invalid code: " <> show c+                  exitFailure+                else pure $ do+                  initialContract (mkCode $ fromJust c')                         & set #origStorage (contract'.origStorage)                         & set #balance     (contract'.balance)                         & set #nonce       (contract'.nonce)                         & set #external    (contract'.external) -    (_, _, Just c)  ->-      pure ((`abstractContract` address) . mkCode $ decipher c)-    (_, _, Nothing) ->-      error "Error: must provide at least (rpc + address) or code"+    (_, _, Just c)  -> do+      let c' = decipher c+      if (isNothing c') then do+        putStrLn $ "Error, invalid code: " <> show c+        exitFailure+      else case storageBase of+        EmptyBase -> pure (initialContract . mkCode $ fromJust c')+        AbstractBase -> pure ((`abstractContract` address) . mkCode $ fromJust c') -  vm <- stToIO $ vm0 baseFee miner ts blockNum prevRan calldata callvalue caller contract+    (_, _, Nothing) -> do+      putStrLn "Error, must provide at least (rpc + address) or code"+      exitFailure++  vm <- stToIO $ vm0 baseFee miner ts blockNum prevRan calldata callvalue caller contract storageBase   pure $ EVM.Transaction.initTx vm    where-    decipher = hexByteString "bytes" . strip0x+    decipher = hexByteString . strip0x     block = maybe Fetch.Latest Fetch.BlockNumber cmd.block     origin = eaddr (.origin) (SymAddr "origin")     mkCode bs = if cmd.create                    then InitCode bs mempty                    else RuntimeCode (ConcreteRuntimeCode bs)     address = eaddr (.address) (SymAddr "entrypoint")-    vm0 baseFee miner ts blockNum prevRan cd callvalue caller c = makeVm $ VMOpts+    vm0 baseFee miner ts blockNum prevRan cd callvalue caller c baseState = makeVm $ VMOpts       { contract       = c       , otherContracts = []       , calldata       = cd@@ -568,9 +635,11 @@       , schedule       = feeSchedule       , chainId        = word (.chainid) 1       , create         = (.create) cmd-      , baseState      = maybe AbstractBase parseInitialStorage (cmd.initialStorage)+      , baseState      = baseState       , txAccessList   = mempty       , allowFFI       = False+      , freshAddresses = 0+      , beaconRoot     = 0       }     word f def = fromMaybe def (f cmd)     word64 f def = fromMaybe def (f cmd)@@ -598,7 +667,7 @@     , rpcInfo = case cmd.rpc of          Just url -> Just (block', url)          Nothing  -> Nothing-    , maxIter = cmd.maxIterations+    , maxIter = parseMaxIters cmd.maxIterations     , askSmtIters = cmd.askSmtIterations     , smtTimeout = cmd.smttimeout     , solver = cmd.solver@@ -607,6 +676,7 @@     , testParams = params     , dapp = srcInfo     , ffiAllowed = cmd.ffi+    , checkFailBit = (fromMaybe Forge cmd.assertionType) == DSTest     } parseInitialStorage :: InitialStorage -> BaseState parseInitialStorage Empty = EmptyBase

+ ethjet/blake2.c view

@@ -0,0 +1,65 @@+#include <stdint.h>+#include "blake2.h"++#define ROTR64(x, y) (((x) >> (y)) ^ ((x) << (64 - (y))))++#define B2B_G(a, b, c, d, x, y)   \+  v[a] = v[a] + v[b] + x;         \+  v[d] = ROTR64(v[d] ^ v[a], 32); \+  v[c] = v[c] + v[d];             \+  v[b] = ROTR64(v[b] ^ v[c], 24); \+  v[a] = v[a] + v[b] + y;         \+  v[d] = ROTR64(v[d] ^ v[a], 16); \+  v[c] = v[c] + v[d];             \+  v[b] = ROTR64(v[b] ^ v[c], 63);++static const uint64_t blake2b_iv[8] = {+  0x6A09E667F3BCC908, 0xBB67AE8584CAA73B,+  0x3C6EF372FE94F82B, 0xA54FF53A5F1D36F1,+  0x510E527FADE682D1, 0x9B05688C2B3E6C1F,+  0x1F83D9ABFB41BD6B, 0x5BE0CD19137E2179+};++static const uint8_t sigma[10][16] = {+  { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 },+  { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 },+  { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 },+  { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 },+  { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 },+  { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 },+  { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 },+  { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 },+  { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 },+  { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13, 0 }+};++void blake2b_compress(uint64_t *h, uint64_t *m, uint64_t *t, char f, uint32_t rounds) {+  uint32_t i;+  uint64_t v[16];++  for (i = 0; i < 8; i++) {+    v[i] = h[i];+    v[i+8] = blake2b_iv[i];+  }++  v[12] ^= t[0];+  v[13] ^= t[1];++  if (f) v[14] = ~v[14];++  int index;+  for (i = 0; i < rounds; i++) {+    index = i % 10;+    B2B_G( 0, 4,  8, 12, m[sigma[index][ 0]], m[sigma[index][ 1]]);+    B2B_G( 1, 5,  9, 13, m[sigma[index][ 2]], m[sigma[index][ 3]]);+    B2B_G( 2, 6, 10, 14, m[sigma[index][ 4]], m[sigma[index][ 5]]);+    B2B_G( 3, 7, 11, 15, m[sigma[index][ 6]], m[sigma[index][ 7]]);+    B2B_G( 0, 5, 10, 15, m[sigma[index][ 8]], m[sigma[index][ 9]]);+    B2B_G( 1, 6, 11, 12, m[sigma[index][10]], m[sigma[index][11]]);+    B2B_G( 2, 7,  8, 13, m[sigma[index][12]], m[sigma[index][13]]);+    B2B_G( 3, 4,  9, 14, m[sigma[index][14]], m[sigma[index][15]]);+  }++  for (i = 0; i < 8; ++i)+    h[i] ^= v[i] ^ v[i+8];+}

− ethjet/blake2.cc

@@ -1,65 +0,0 @@-#include <cstdint>-#include "blake2.h"--#define ROTR64(x, y) (((x) >> (y)) ^ ((x) << (64 - (y))))--#define B2B_G(a, b, c, d, x, y)   \-  v[a] = v[a] + v[b] + x;         \-  v[d] = ROTR64(v[d] ^ v[a], 32); \-  v[c] = v[c] + v[d];             \-  v[b] = ROTR64(v[b] ^ v[c], 24); \-  v[a] = v[a] + v[b] + y;         \-  v[d] = ROTR64(v[d] ^ v[a], 16); \-  v[c] = v[c] + v[d];             \-  v[b] = ROTR64(v[b] ^ v[c], 63);--static const uint64_t blake2b_iv[8] = {-  0x6A09E667F3BCC908, 0xBB67AE8584CAA73B,-  0x3C6EF372FE94F82B, 0xA54FF53A5F1D36F1,-  0x510E527FADE682D1, 0x9B05688C2B3E6C1F,-  0x1F83D9ABFB41BD6B, 0x5BE0CD19137E2179-};--static const uint8_t sigma[10][16] = {-  { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 },-  { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 },-  { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 },-  { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 },-  { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 },-  { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 },-  { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 },-  { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 },-  { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 },-  { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13, 0 }-};--void blake2b_compress(uint64_t *h, uint64_t *m, uint64_t *t, char f, uint32_t rounds) {-  uint32_t i;-  uint64_t v[16];--  for (i = 0; i < 8; i++) {-    v[i] = h[i];-    v[i+8] = blake2b_iv[i];-  }--  v[12] ^= t[0];-  v[13] ^= t[1];--  if (f) v[14] = ~v[14];--  int index;-  for (i = 0; i < rounds; i++) {-    index = i % 10;-    B2B_G( 0, 4,  8, 12, m[sigma[index][ 0]], m[sigma[index][ 1]]);-    B2B_G( 1, 5,  9, 13, m[sigma[index][ 2]], m[sigma[index][ 3]]);-    B2B_G( 2, 6, 10, 14, m[sigma[index][ 4]], m[sigma[index][ 5]]);-    B2B_G( 3, 7, 11, 15, m[sigma[index][ 6]], m[sigma[index][ 7]]);-    B2B_G( 0, 5, 10, 15, m[sigma[index][ 8]], m[sigma[index][ 9]]);-    B2B_G( 1, 6, 11, 12, m[sigma[index][10]], m[sigma[index][11]]);-    B2B_G( 2, 7,  8, 13, m[sigma[index][12]], m[sigma[index][13]]);-    B2B_G( 3, 4,  9, 14, m[sigma[index][14]], m[sigma[index][15]]);-  }--  for (i = 0; i < 8; ++i)-    h[i] ^= v[i] ^ v[i+8];-}

ethjet/ethjet-ff.cc view

@@ -44,10 +44,6 @@     alt_bn128_Fq x0 = read_Fq_element(in+32);     alt_bn128_Fq x1 = read_Fq_element(in); -    mpz_t q;-    mpz_init(q);-    alt_bn128_modulus_q.to_mpz(q);-     return Fp2_model<alt_bn128_q_limbs, alt_bn128_modulus_q>(x0, x1);   } @@ -58,9 +54,6 @@     mpz_init(x_data);     mpz_import(x_data, 32, 1, sizeof(in[0]), 1, 0, in); -    mpz_t r;-    mpz_init(r);-    alt_bn128_modulus_r.to_mpz(r);     const mp_size_t limbs = alt_bn128_r_limbs;      return Fp_model<limbs, alt_bn128_modulus_r>(bigint<limbs>(x_data));@@ -123,7 +116,7 @@     }     // copy the result to the output buffer     // with padding-    for (int i = 1; i <= 32; i++) {+    for (size_t i = 1; i <= 32; i++) {       if (i <= x_size)         out[32-i] = x_arr[x_size-i];       else

hevm.cabal view

@@ -2,9 +2,11 @@ name:   hevm version:-  0.53.0+  0.54.2 synopsis:   Symbolic EVM Evaluator+description:+  Symbolic EVM semantics in Haskell. homepage:   https://github.com/ethereum/hevm license:@@ -18,10 +20,16 @@ build-type:   Simple extra-source-files:-  CHANGELOG.md   bench/contracts/*.sol   test/scripts/convert_trace_to_json.sh+extra-doc-files:+  CHANGELOG.md +flag static-secp256k1+  description: Sets flags for compilation with static secp256k1+  default:     False+  manual:      True+ flag ci   description: Sets flags for compilation in CI   default:     False@@ -43,9 +51,13 @@  common shared   if flag(ci)-    ghc-options: -Werror+    ghc-options:+      -Werror+      -- FIXME: we have to disable this, due to ghc bug: https://gitlab.haskell.org/ghc/ghc/-/issues/24120+      -Wno-unused-packages   if flag(devel)-    ghc-options: -j+    ghc-options:+      -j   if flag(debug)     ghc-options:       -j@@ -58,6 +70,7 @@     -Wno-unticked-promoted-constructors     -Wno-orphans     -Wno-ambiguous-fields+    -Wunused-packages     -optc-Wno-ignored-attributes     -fspecialize-aggressively     -fexpose-all-unfoldings@@ -105,39 +118,34 @@     EVM.Sign,     EVM.Effects,   other-modules:+    EVM.CheatsTH,     Paths_hevm   autogen-modules:     Paths_hevm-  if impl(ghc >= 9.4) && !os(darwin)-    -- darwin is skipped because it produces this error when building-    -- > ghc: loadArchive: Neither an archive, nor a fat archive: `/nix/store/l3lkdfm7sg1wwc850451cikqds766h15-clang-wrapper-11.1.0/bin/clang++'-    build-depends: system-cxx-std-lib-  elif !os(darwin)-    extra-libraries: stdc++-  else-    -- extra-libraries: c+++  if os(windows) && flag(static-secp256k1)+    cc-options: -DSECP256K1_STATIC+    cxx-options: -DSECP256K1_STATIC+  if os(darwin)     -- https://gitlab.haskell.org/ghc/ghc/-/issues/11829     ld-options: -Wl,-keep_dwarf_unwind     ghc-options: -fcompact-unwind   extra-libraries:     secp256k1, ff, gmp   c-sources:-    ethjet/tinykeccak.c, ethjet/ethjet.c+    ethjet/tinykeccak.c, ethjet/blake2.c, ethjet/ethjet.c   cxx-sources:-    ethjet/ethjet-ff.cc, ethjet/blake2.cc+    ethjet/ethjet-ff.cc   cxx-options:     -std=c++0x   install-includes:     ethjet/tinykeccak.h, ethjet/ethjet.h, ethjet/ethjet-ff.h, ethjet/blake2.h   build-depends:+    system-cxx-std-lib                >= 1.0 && < 2.0,     QuickCheck                        >= 2.13.2 && < 2.15,     Decimal                           >= 0.5.1 && < 0.6,     containers                        >= 0.6.0 && < 0.7,-    deepseq                           >= 1.4.4 && < 1.5,-    time                              >= 1.11 && < 1.14,-    transformers                      >= 0.5.6 && < 0.6,+    transformers                      >= 0.5 && < 0.7,     tree-view                         >= 0.5 && < 0.6,-    abstract-par                      >= 0.3.3 && < 0.4,     aeson                             >= 2.0.0 && < 2.2,     bytestring                        >= 0.11.3.1 && < 0.12,     scientific                        >= 0.3.6 && < 0.4,@@ -145,49 +153,38 @@     text                              >= 1.2.3 && < 2.1,     unordered-containers              >= 0.2.10 && < 0.3,     vector                            >= 0.12.1 && < 0.14,-    base16                            >= 0.3.2.0 && < 0.3.3.0,+    base16                            >= 1.0 && < 1.1,     megaparsec                        >= 9.0.0 && < 10.0,-    mtl                               >= 2.2.2 && < 2.3,-    directory                         >= 1.3.3 && < 1.4,+    mtl                               >= 2.2 && < 2.4,     filepath                          >= 1.4.2 && < 1.5,     cereal                            >= 0.5.8 && < 0.6,     cryptonite                        >= 0.30 && < 0.31,     memory                            >= 0.16.0 && < 0.20,     data-dword                        >= 0.3.1 && < 0.4,-    free                              >= 5.1.3 && < 5.2,-    haskeline                         >= 0.8.0 && < 0.9,     process                           >= 1.6.5 && < 1.7,     optics-core                       >= 0.4.1 && < 0.5,     optics-extra                      >= 0.4.2.1 && < 0.5,     optics-th                         >= 0.4.1 && < 0.5,     aeson-optics                      >= 1.2.0.1 && < 1.3,-    monad-par                         >= 0.3.5 && < 0.4,     async                             >= 2.2.4 && < 2.3,-    multiset                          >= 0.3.4 && < 0.4,     operational                       >= 0.2.3 && < 0.3,-    optparse-generic                  >= 1.3.1 && < 1.5,+    optparse-generic                  >= 1.3.1 && < 1.6,     pretty-hex                        >= 1.1 && < 1.2,-    quickcheck-text                   >= 0.1.2 && < 0.2,-    restless-git                      >= 0.7 && < 0.8,     rosezipper                        >= 0.2 && < 0.3,-    temporary                         >= 1.3 && < 1.4,-    witherable                        >= 0.3.5 && < 0.5,     wreq                              >= 0.5.3 && < 0.6,     regex-tdfa                        >= 1.2.3 && < 1.4,     base                              >= 4.9 && < 5,     here                              >= 1.2.13 && < 1.3,-    smt2-parser                       >= 0.1.0.1,-    word-wrap                         >= 0.5 && < 0.6,+    smt2-parser                       >= 0.1.0 && < 0.2,     spool                             >= 0.1 && < 0.2,     stm                               >= 2.5.0 && < 2.6.0,     spawn                             >= 0.3 && < 0.4,     filepattern                       >= 0.1.2 && < 0.2,     witch                             >= 1.1 && < 1.3,-    unliftio-core                     >= 0.2.1.0-  if !os(windows)-    build-depends:-      brick                           >= 1.4 && < 2.0,-      vty                             >= 5.37 && < 5.39+    unliftio-core                     >= 0.2.1 && < 0.3,+    split                             >= 0.2.3 && < 0.3,+    template-haskell                  >= 2.19.0 && < 3,+    extra                             >= 1.7.14 && < 2,   hs-source-dirs:     src @@ -200,45 +197,22 @@   ghc-options: -threaded -with-rtsopts=-N   other-modules:     Paths_hevm-  if os(darwin)-    extra-libraries: c+++  autogen-modules:+    Paths_hevm   build-depends:-    QuickCheck,-    aeson,-    async,     base,-    base16,-    binary,-    brick,     bytestring,-    containers,-    cryptonite,     data-dword,-    deepseq,     directory,     filepath,-    free,     hevm,-    memory,-    mtl,     optparse-generic,-    operational,-    process,-    quickcheck-text,-    regex-tdfa,-    temporary,     text,-    unordered-containers,-    vector,-    vty,-    stm,-    spawn,     optics-core,-    githash                       >= 0.1.6 && < 0.2,+    githash,     witch,-    unliftio-core-  if os(windows)-    buildable: False+    unliftio-core,+    with-utf8,  --- Test Helpers --- @@ -251,60 +225,44 @@   autogen-modules:     Paths_hevm   build-depends:-    HUnit >= 1.6,     QuickCheck,     quickcheck-instances,     aeson,     base,-    base16,-    binary,     containers,     directory,+    extra,     bytestring,     filemanip,     filepath,-    here,     hevm,+    here,     mtl,-    data-dword,     process,-    tasty >= 1.0,-    tasty-hunit >= 0.10,-    tasty-quickcheck >= 0.9,-    tasty-expected-failure >= 0.12,+    tasty,+    tasty-hunit,+    tasty-quickcheck,+    tasty-expected-failure,     temporary,     text,-    regex-tdfa,-    regex,-    time,-    array,     vector,-    tasty-bench,-    stm >= 2.5.0,-    spawn >= 0.3,     witherable,-    smt2-parser >= 0.1.0.1,     operational,     optics-core,     optics-extra,     witch,     unliftio-core,-    exceptions,-    MissingH+    exceptions  library test-utils-  import:-    test-base+  import: test-base   exposed-modules:     EVM.Test.Utils     EVM.Test.Tracing     EVM.Test.BlockchainTests-  if os(windows)-    buildable: False  common test-common-  import:-    test-base+  import: test-base   if flag(devel)     ghc-options: -threaded -with-rtsopts=-N   build-depends:@@ -313,34 +271,33 @@     EVM.Test.Utils     EVM.Test.Tracing     EVM.Test.BlockchainTests-  if os(windows)-    buildable: False-  if os(darwin)-    extra-libraries: c++  --- Test Suites ---  test-suite test-  import:-    test-common+  import: test-common   type:     exitcode-stdio-1.0   main-is:     test.hs+  build-depends:+    base16,+    binary,+    data-dword,+    time,+    regex  -- these tests require network access so we split them into a separate test -- suite to make it easy to skip them when running nix-build test-suite rpc-tests-  import:-    test-common+  import: test-common   type:     exitcode-stdio-1.0   main-is:     rpc.hs  test-suite ethereum-tests-  import:-    test-common+  import: test-common   type:     exitcode-stdio-1.0   main-is:@@ -358,8 +315,6 @@     bench   ghc-options:     -O2-  if os(darwin)-    extra-libraries: c++   other-modules:     Paths_hevm   autogen-modules:@@ -371,10 +326,8 @@     bytestring,     text,     hevm,-    here,     test-utils,     filemanip,     filepath,     containers,-    mtl,     unliftio-core

src/EVM.hs view

@@ -1,5 +1,5 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE TemplateHaskell #-}  module EVM where @@ -13,7 +13,7 @@  import EVM.ABI import EVM.Expr (readStorage, writeStorage, readByte, readWord, writeWord,-  writeByte, bufLength, indexWord, litAddr, readBytes, word256At, copySlice, wordToAddr)+  writeByte, bufLength, indexWord, readBytes, copySlice, wordToAddr) import EVM.Expr qualified as Expr import EVM.FeeSchedule (FeeSchedule (..)) import EVM.Op@@ -23,18 +23,26 @@ import EVM.Types qualified as Expr (Expr(Gas)) import EVM.Sign qualified import EVM.Concrete qualified as Concrete+import EVM.CheatsTH +import Control.Monad (unless, when) import Control.Monad.ST (ST)-import Control.Monad.State.Strict hiding (state)+import Control.Monad.State.Strict (MonadState, State, get, gets, lift, modify', put) import Data.Bits (FiniteBits, countLeadingZeros, finiteBitSize) import Data.ByteArray qualified as BA import Data.ByteString (ByteString) import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.ByteString.Base16 qualified as BS16 import Data.ByteString.Lazy (fromStrict) import Data.ByteString.Lazy qualified as LS import Data.ByteString.Char8 qualified as Char8+import Data.DoubleWord (Int256, Word256)+import Data.Either (partitionEithers)+import Data.Either.Extra (maybeToEither) import Data.Foldable (toList)-import Data.List (find)+import Data.List (find, isPrefixOf)+import Data.List.Split (splitOn) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe, fromJust, isJust)@@ -52,7 +60,8 @@ import Data.Vector.Unboxed qualified as VUnboxed import Data.Vector.Unboxed.Mutable qualified as VUnboxed.Mutable import Data.Word (Word8, Word32, Word64)-import Witch (into, tryFrom, unsafeInto)+import Text.Read (readMaybe)+import Witch (into, tryFrom, unsafeInto, tryInto)  import Crypto.Hash (Digest, SHA256, RIPEMD160) import Crypto.Hash qualified as Crypto@@ -75,6 +84,8 @@     , gas          = initialGas     , returndata   = mempty     , static       = False+    , overrideCaller = Nothing+    , resetCaller  = False     }  -- | An "external" view of a contract's bytecode, appropriate for@@ -93,7 +104,7 @@   Map.lookup vm.state.codeContract vm.env.contracts  -- * Data constructors-+-- makeVm :: VMOps t => VMOpts t -> ST s (VM t s) makeVm o = do   let txaccessList = o.txAccessList@@ -106,7 +117,7 @@       initialAccessedStorageKeys = fromList $ foldMap (uncurry (map . (,))) (Map.toList txaccessList)       touched = if o.create then [txorigin] else [txorigin, txtoAddr]   memory <- ConcreteMemory <$> VUnboxed.Mutable.new 0-  pure $ VM+  pure $ setEIP4788Storage o $ VM     { result = Nothing     , frames = mempty     , tx = TxState@@ -116,7 +127,7 @@       , origin = txorigin       , toAddr = txtoAddr       , value = o.value-      , substate = SubState mempty touched initialAccessedAddrs initialAccessedStorageKeys mempty+      , subState = SubState mempty touched initialAccessedAddrs initialAccessedStorageKeys mempty mempty       , isCreate = o.create       , txReversion = Map.fromList ((o.address,o.contract):o.otherContracts)       }@@ -137,6 +148,8 @@       , gas = o.gas       , returndata = mempty       , static = False+      , overrideCaller = Nothing+      , resetCaller = False       }     , env = env     , cache = cache@@ -145,17 +158,18 @@     , iterations = mempty     , config = RuntimeConfig       { allowFFI = o.allowFFI-      , overrideCaller = Nothing       , baseState = o.baseState       }     , forks = Seq.singleton (ForkState env block cache "")     , currentFork = 0+    , labels = mempty+    , osEnv = mempty     }     where     env = Env       { chainId = o.chainId       , contracts = Map.fromList ((o.address,o.contract):o.otherContracts)-      , freshAddresses = 0+      , freshAddresses = o.freshAddresses       , freshGasVals = 0       }     block = Block@@ -170,11 +184,41 @@       }     cache = Cache mempty mempty +-- https://eips.ethereum.org/EIPS/eip-4788+setEIP4788Storage :: VMOpts t -> VM t s -> VM t s+setEIP4788Storage o vm = do+  let beaconRootsAddress = LitAddr 0x000F3df6D732807Ef1319fB7B8bB8522d0Beac02+  case Map.lookup beaconRootsAddress vm.env.contracts of+    Just beaconRootsContract -> do+      -- https://eips.ethereum.org/EIPS/eip-4788#pseudocode+      -- https://eips.ethereum.org/EIPS/eip-4788#block-processing+      -- > Clients may decide to omit an explicit EVM call and directly set the+      -- > storage values. Note: While this is a valid optimization for Ethereum+      -- > mainnet, it could be problematic on non-mainnet situations in case+      -- > a different contract is used.+      let+        historyBufferLength = 8191+        timestampIdx = Expr.mod o.timestamp (Lit historyBufferLength)+        rootIdx = Expr.add timestampIdx (Lit historyBufferLength)+        storage =+          Expr.writeStorage timestampIdx o.timestamp .+          Expr.writeStorage rootIdx (Lit o.beaconRoot) $+          beaconRootsContract.storage+      vm {+        env = vm.env {+          contracts = Map.insert beaconRootsAddress+                                 (beaconRootsContract { storage } :: Contract)+                                 vm.env.contracts+        }+      }+    Nothing -> vm+ -- | Initialize an abstract contract with unknown code unknownContract :: Expr EAddr -> Contract unknownContract addr = Contract   { code        = UnknownCode addr   , storage     = AbstractStore addr Nothing+  , tStorage    = AbstractStore addr Nothing   , origStorage = AbstractStore addr Nothing   , balance     = Balance addr   , nonce       = Nothing@@ -189,6 +233,7 @@ abstractContract code addr = Contract   { code        = code   , storage     = AbstractStore addr Nothing+  , tStorage    = AbstractStore addr Nothing   , origStorage = AbstractStore addr Nothing   , balance     = Balance addr   , nonce       = if isCreation code then Just 1 else Just 0@@ -207,6 +252,7 @@ initialContract code = Contract   { code        = code   , storage     = ConcreteStore mempty+  , tStorage    = ConcreteStore mempty   , origStorage = ConcreteStore mempty   , balance     = Lit 0   , nonce       = if isCreation code then Just 1 else Just 0@@ -228,6 +274,18 @@ next :: (?op :: Word8) => EVM t s () next = modifying (#state % #pc) (+ (opSize ?op)) +getOpW8 :: forall (t :: VMType) s . FrameState t s -> Word8+getOpW8 state = case state.code of+      UnknownCode _ -> internalError "Cannot execute unknown code"+      InitCode conc _ -> BS.index conc state.pc+      RuntimeCode (ConcreteRuntimeCode bs) -> BS.index bs state.pc+      RuntimeCode (SymbolicRuntimeCode ops) ->+        fromMaybe (internalError "could not analyze symbolic code") $+          maybeLitByte $ ops V.! state.pc++getOpName :: forall (t :: VMType) s . FrameState t s -> [Char]+getOpName state = intToOpName $ fromEnum $ getOpW8 state+ -- | Executes the EVM one step exec1 :: forall (t :: VMType) s. VMOps t => EVM t s () exec1 = do@@ -245,7 +303,7 @@      litSelf = maybeLitAddr self -  if isJust litSelf && (fromJust litSelf) > 0x0 && (fromJust litSelf) <= 0x9 then do+  if isJust litSelf && (fromJust litSelf) > 0x0 && (fromJust litSelf) <= 0xa then do     -- call to precompile     let ?op = 0x00 -- dummy value     let calldatasize = bufLength vm.state.calldata@@ -264,7 +322,7 @@             out <- use (#state % #returndata)             finishFrame (FrameReturned out)         e -> partial $-               UnexpectedSymbolicArg vmx.state.pc "precompile returned a symbolic value" (wrap [e])+               UnexpectedSymbolicArg vmx.state.pc (getOpName vmx.state) "precompile returned a symbolic value" (wrap [e])       _ ->         underrun @@ -272,13 +330,8 @@     then doStop      else do-      let ?op = case vm.state.code of-                  UnknownCode _ -> internalError "Cannot execute unknown code"-                  InitCode conc _ -> BS.index conc vm.state.pc-                  RuntimeCode (ConcreteRuntimeCode bs) -> BS.index bs vm.state.pc-                  RuntimeCode (SymbolicRuntimeCode ops) ->-                    fromMaybe (internalError "could not analyze symbolic code") $-                      maybeLitByte $ ops V.! vm.state.pc+      let ?op = getOpW8 vm.state+      let opName = getOpName vm.state        case getOp (?op) of @@ -489,7 +542,7 @@                         Just b -> copyBytesToMemory b codeSize codeOffset memOffset                         Nothing -> do                           pc <- use (#state % #pc)-                          partial $ UnexpectedSymbolicArg pc "Cannot copy from unknown code at" (wrap [extAccount])+                          partial $ UnexpectedSymbolicArg pc opName "Cannot copy from unknown code at" (wrap [extAccount])             _ -> underrun          OpReturndatasize ->@@ -572,6 +625,13 @@           limitStack 1 . burn g_base $             next >> push vm.block.baseFee +        OpBlobhash ->+          stackOp1 g_verylow $ \_ -> Lit 0++        OpBlobBaseFee ->+          limitStack 1 . burn g_base $+            next >> push 0+         OpPop ->           case stk of             _:xs -> burn g_base (next >> assign (#state % #stack) xs)@@ -588,6 +648,34 @@                   assign (#state % #stack) (w : xs)             _ -> underrun ++        OpMcopy ->+          case stk of+            dstOff:srcOff:sz:xs ->  do+              case sz of+                Lit sz' -> do+                  let words_copied = (sz' + 31) `div` 32+                  let g_mcopy = 3*words_copied -- memory access cost is part of accessMemoryRange+                  burn (g_verylow + (unsafeInto g_mcopy)) $+                    accessMemoryRange srcOff sz $ accessMemoryRange dstOff sz $ do+                      next+                      mcopy sz srcOff dstOff+                _ -> do+                  -- symbolic, ignore gas+                  next+                  mcopy sz srcOff dstOff+              assign (#state % #stack) xs+            _ -> underrun+            where+            mcopy sz srcOff dstOff = do+                  m <- gets (.state.memory)+                  case m of+                    ConcreteMemory mem -> do+                      buf <- freezeMemory mem+                      copyBytesToMemory buf sz srcOff dstOff+                    SymbolicMemory mem -> do+                      assign (#state % #memory) (SymbolicMemory $ copySlice srcOff dstOff sz mem mem)+         OpMstore ->           case stk of             x:y:xs ->@@ -691,13 +779,32 @@                        _ -> noop             _ -> underrun +        OpTload ->+          case stk of+            x:xs -> do+              burn g_warm_storage_read $+                accessTStorage self x $ \y -> do+                  next+                  assign (#state % #stack) (y:xs)+            _ -> underrun++        OpTstore ->+          notStatic $+          case stk of+            x:new:xs ->+              burn g_sload $ do+                next+                modifying (#env % #contracts % ix self % #tStorage) (writeStorage x new)+                assign (#state % #stack) xs+            _ -> underrun+         OpJump ->           case stk of             x:xs ->               burn g_mid $ forceConcrete x "JUMP: symbolic jumpdest" $ \x' ->-                case toInt x' of-                  Nothing -> vmError BadJumpDestination-                  Just i -> checkJump i xs+                case tryInto x' of+                  Left _ -> vmError BadJumpDestination+                  Right i -> checkJump i xs             _ -> underrun          OpJumpi ->@@ -706,9 +813,9 @@               burn g_high $                 let jump :: Bool -> EVM t s ()                     jump False = assign (#state % #stack) xs >> next-                    jump _    = case toInt x' of-                      Nothing -> vmError BadJumpDestination-                      Just i -> checkJump i xs+                    jump _    = case tryInto x' of+                      Left _ -> vmError BadJumpDestination+                      Right i -> checkJump i xs                 in branch y jump             _ -> underrun @@ -745,13 +852,20 @@             xValue:xOffset:xSize:xs ->               accessMemoryRange xOffset xSize $ do                 availableGas <- use (#state % #gas)-                let-                  (cost, gas') = costOfCreate fees availableGas xSize False-                newAddr <- createAddress self this.nonce+                let (cost, gas') = costOfCreate fees availableGas xSize False++                -- handle `prank`+                let from' = fromMaybe self vm.state.overrideCaller+                resetCaller <- use (#state % #resetCaller)+                when resetCaller $ do+                  assign (#state % #overrideCaller) Nothing+                  assign (#state % #resetCaller) False++                newAddr <- createAddress from' this.nonce                 _ <- accessAccountForGas newAddr                 burn' cost $ do                   initCode <- readMemory xOffset xSize-                  create self this xSize gas' xValue xs newAddr initCode+                  create from' this xSize gas' xValue xs newAddr initCode             _ -> underrun          OpCall ->@@ -762,15 +876,15 @@                   forceAddr xTo' "unable to determine a call target" $ \xTo ->                     case gasTryFrom xGas of                       Left _ -> vmError IllegalOverflow-                      Right gas ->+                      Right gas -> do+                        overrideC <- use $ #state % #overrideCaller                         delegateCall this gas xTo xTo xValue xInOffset xInSize xOutOffset xOutSize xs $                           \callee -> do-                            let from' = fromMaybe self vm.config.overrideCaller+                            let from' = fromMaybe self overrideC                             zoom #state $ do                               assign #callvalue xValue                               assign #caller from'                               assign #contract callee-                            assign (#config % #overrideCaller) Nothing                             touchAccount from'                             touchAccount callee                             transfer from' callee xValue@@ -783,12 +897,12 @@               forceAddr xTo' "unable to determine a call target" $ \xTo ->                 case gasTryFrom xGas of                   Left _ -> vmError IllegalOverflow-                  Right gas ->+                  Right gas -> do+                    overrideC <- use $ #state % #overrideCaller                     delegateCall this gas xTo self xValue xInOffset xInSize xOutOffset xOutSize xs $ \_ -> do                       zoom #state $ do                         assign #callvalue xValue-                        assign #caller $ fromMaybe self vm.config.overrideCaller-                      assign (#config % #overrideCaller) Nothing+                        assign #caller $ fromMaybe self overrideC                       touchAccount self             _ ->               underrun@@ -833,7 +947,7 @@                 Nothing -> do                   loc <- codeloc                   let msg = "Unable to determine a call target"-                  partial $ UnexpectedSymbolicArg (snd loc) msg [SomeExpr xTo]+                  partial $ UnexpectedSymbolicArg (snd loc) opName msg [SomeExpr xTo]                 Just xTo' ->                   case gasTryFrom xGas of                     Left _ -> vmError IllegalOverflow@@ -851,12 +965,18 @@                   buf <- readMemory xOffset xSize                   forceConcreteBuf buf "CREATE2" $                     \initCode -> do-                      let-                        (cost, gas') = costOfCreate fees availableGas xSize True+                      -- handle `prank`+                      let from' = fromMaybe self vm.state.overrideCaller+                      resetCaller <- use (#state % #resetCaller)+                      when resetCaller $ do+                        assign (#state % #overrideCaller) Nothing+                        assign (#state % #resetCaller) False++                      let (cost, gas') = costOfCreate fees availableGas xSize True                       newAddr <- create2Address self xSalt initCode                       _ <- accessAccountForGas newAddr                       burn' cost $-                        create self this xSize gas' xValue xs newAddr (ConcreteBuf initCode)+                        create from' this xSize gas' xValue xs newAddr (ConcreteBuf initCode)             _ -> underrun          OpStaticcall ->@@ -866,19 +986,19 @@                 Nothing -> do                   loc <- codeloc                   let msg = "Unable to determine a call target"-                  partial $ UnexpectedSymbolicArg (snd loc) msg [SomeExpr xTo]+                  partial $ UnexpectedSymbolicArg (snd loc) opName msg [SomeExpr xTo]                 Just xTo' ->                   case gasTryFrom xGas of                     Left _ -> vmError IllegalOverflow-                    Right gas ->+                    Right gas -> do+                      overrideC <- use $ #state % #overrideCaller                       delegateCall this gas xTo' xTo' (Lit 0) xInOffset xInSize xOutOffset xOutSize xs $                         \callee -> do                           zoom #state $ do                             assign #callvalue (Lit 0)-                            assign #caller $ fromMaybe self (vm.config.overrideCaller)+                            assign #caller $ fromMaybe self overrideC                             assign #contract callee                             assign #static True-                          assign (#config % #overrideCaller) Nothing                           touchAccount self                           touchAccount callee             _ ->@@ -890,6 +1010,8 @@             [] -> underrun             (xTo':_) -> forceAddr xTo' "SELFDESTRUCT" $ \case               xTo@(LitAddr _) -> do+                cc <- gets (.tx.subState.createdContracts)+                let createdThisTr = self `member` cc                 acc <- accessAccountForGas xTo                 let cost = if acc then 0 else g_cold_account_access                     funds = this.balance@@ -899,19 +1021,21 @@                               then g_selfdestruct_newaccount                               else 0                   burn (g_selfdestruct + c_new + cost) $ do-                    selfdestruct self+                    when (createdThisTr || isCreation this.code) $ do+                      selfdestruct self                     touchAccount xTo                      if hasFunds                     then fetchAccount xTo $ \_ -> do-                           #env % #contracts % ix xTo % #balance %= (Expr.add funds)-                           assign (#env % #contracts % ix self % #balance) (Lit 0)-                           doStop-                    else do+                      when (createdThisTr || xTo /= self) $ do+                        #env % #contracts % ix xTo % #balance %= (Expr.add funds)+                        assign (#env % #contracts % ix self % #balance) (Lit 0)                       doStop+                    else+                      doStop               a -> do                 pc <- use (#state % #pc)-                partial $ UnexpectedSymbolicArg pc "trying to self destruct to a symbolic address" (wrap [a])+                partial $ UnexpectedSymbolicArg pc opName "trying to self destruct to a symbolic address" (wrap [a])          OpRevert ->           case stk of@@ -949,7 +1073,8 @@           transfer src dst val         SymAddr _ -> do           pc <- use (#state % #pc)-          partial $ UnexpectedSymbolicArg pc "Attempting to transfer eth from a symbolic address that is not present in the state" (wrap [src])+          state <- use #state+          partial $ UnexpectedSymbolicArg pc (getOpName state) "Attempting to transfer eth from a symbolic address that is not present in the state" (wrap [src])         GVar _ -> internalError "Unexpected GVar"     -- recipient not in state     (_ , Nothing) -> do@@ -959,7 +1084,8 @@           transfer src dst val         SymAddr _ -> do           pc <- use (#state % #pc)-          partial $ UnexpectedSymbolicArg pc "Attempting to transfer eth to a symbolic address that is not present in the state" (wrap [dst])+          state <- use #state+          partial $ UnexpectedSymbolicArg pc (getOpName state) "Attempting to transfer eth to a symbolic address that is not present in the state" (wrap [dst])         GVar _ -> internalError "Unexpected GVar"  -- | Checks a *CALL for failure; OOG, too many callframes, memory access etc.@@ -985,7 +1111,7 @@     accessMemoryRange xOutOffset xOutSize $ do       availableGas <- use (#state % #gas)       let recipientExists = accountExists xContext vm-      let from = fromMaybe vm.state.contract vm.config.overrideCaller+      let from = fromMaybe vm.state.contract vm.state.overrideCaller       fromBal <- preuse $ #env % #contracts % ix from % #balance       costOfCall fees recipientExists xValue availableGas xGas xTo $ \cost gas' -> do         let checkCallDepth =@@ -1025,12 +1151,10 @@             -- adding a symbolic address into the state here would be unsound (due to potential aliasing)             SymAddr _ -> do               pc <- use (#state % #pc)-              partial $ UnexpectedSymbolicArg pc "Attempting to transfer eth from a symbolic address that is not present in the state" (wrap [from])+              state <- use #state+              partial $ UnexpectedSymbolicArg pc (getOpName state) "Attempting to transfer eth from a symbolic address that is not present in the state" (wrap [from])             GVar _ -> internalError "Unexpected GVar" --- precompiledContract   :: (?op :: Word8, VMOps t)   => Contract@@ -1049,6 +1173,7 @@       stk <- use (#state % #stack)       pc' <- use (#state % #pc)       result' <- use #result+      vm <- get       case result' of         Nothing -> case stk of           x:_ -> case maybeLitWord x of@@ -1060,7 +1185,7 @@                 touchAccount (LitAddr recipient)                 transfer self (LitAddr recipient) xValue             _ -> partial $-                   UnexpectedSymbolicArg pc' "unexpected return value from precompile" (wrap [x])+                   UnexpectedSymbolicArg pc' (getOpName vm.state) "unexpected return value from precompile" (wrap [x])           _ -> underrun         _ -> pure () @@ -1268,7 +1393,8 @@     Nothing -> case addr of       SymAddr _ -> do         pc <- use (#state % #pc)-        partial $ UnexpectedSymbolicArg pc "trying to access a symbolic address that isn't already present in storage" (wrap [addr])+        state <- use #state+        partial $ UnexpectedSymbolicArg pc (getOpName state) "trying to access a symbolic address that isn't already present in storage" (wrap [addr])       LitAddr a -> do         use (#cache % #fetched % at a) >>= \case           Just c -> do@@ -1307,13 +1433,13 @@       fetchAccount addr $ \_ ->         accessStorage addr slot continue   where-      rpcCall c slotConc = if c.external+      rpcCall c slotConc = fetchAccount addr $ \_ ->+        if c.external         then forceConcreteAddr addr "cannot read storage from symbolic addresses via rpc" $ \addr' ->           forceConcrete slotConc "cannot read symbolic slots via RPC" $ \slot' -> do             -- check if the slot is cached-            contract <- preuse (#cache % #fetched % ix addr')-            case contract of-              Nothing -> internalError "contract marked external not found in cache"+            use (#env % #contracts % at (LitAddr addr')) >>= \case+              Nothing -> internalError $ "contract addr " <> show addr' <> " marked external not found in cache"               Just fetched -> case readStorage (Lit slot') fetched.storage of                           Nothing -> mkQuery addr' slot'                           Just val -> continue val@@ -1328,6 +1454,29 @@               assign #result Nothing               continue (Lit x)) +accessTStorage+  :: VMOps t => Expr EAddr+  -> Expr EWord+  -> (Expr EWord -> EVM t s ())+  -> EVM t s ()+accessTStorage addr slot continue = do+  let slotConc = Expr.concKeccakSimpExpr slot+  use (#env % #contracts % at addr) >>= \case+    Just c ->+      -- Try first without concretization. Then if we get a Just, with concretization+      -- See `accessStorage` for more details+      case readStorage slot c.tStorage of+        Just x -> case readStorage slotConc c.tStorage of+          Just _ -> continue x+          Nothing -> continue $ Lit 0+        Nothing -> continue $ Lit 0+    Nothing ->+      fetchAccount addr $ \_ ->+        accessTStorage addr slot continue++clearTStorages :: EVM t s ()+clearTStorages = (#env % #contracts) %= fmap (\c -> c { tStorage = ConcreteStore mempty } :: Contract)+ accountExists :: Expr EAddr -> VM t s -> Bool accountExists addr vm =   case Map.lookup addr vm.env.contracts of@@ -1350,7 +1499,7 @@ finalize = do   let     revertContracts  = use (#tx % #txReversion) >>= assign (#env % #contracts)-    revertSubstate   = assign (#tx % #substate) (SubState mempty mempty mempty mempty mempty)+    revertSubstate   = assign (#tx % #subState) (SubState mempty mempty mempty mempty mempty mempty)    use #result >>= \case     Just (VMFailure (Revert _)) -> do@@ -1362,23 +1511,24 @@       revertContracts       revertSubstate     Just (VMSuccess output) -> do+      clearTStorages       -- deposit the code from a creation tx       pc' <- use (#state % #pc)       creation <- use (#tx % #isCreate)       createe  <- use (#state % #contract)       createeExists <- (Map.member createe) <$> use (#env % #contracts)-      let onContractCode contractCode =-            when (creation && createeExists) $ replaceCode createe contractCode-      case output of-        ConcreteBuf bs ->-          onContractCode $ RuntimeCode (ConcreteRuntimeCode bs)-        _ ->-          case Expr.toList output of-            Nothing ->-              partial $-                UnexpectedSymbolicArg pc' "runtime code cannot have an abstract length" (wrap [output])-            Just ops ->-              onContractCode $ RuntimeCode (SymbolicRuntimeCode ops)+      when (creation && createeExists) $+        case output of+          ConcreteBuf bs ->+            replaceCode createe (RuntimeCode (ConcreteRuntimeCode bs))+          _ ->+            case Expr.toList output of+              Nothing -> do+                state <- use #state+                partial $+                  UnexpectedSymbolicArg pc' (getOpName state) "runtime code cannot have an abstract length" (wrap [output])+              Just ops ->+                replaceCode createe (RuntimeCode (SymbolicRuntimeCode ops))     _ ->       internalError "Finalising an unfinished tx." @@ -1398,11 +1548,11 @@   -- (see Yellow Paper "Accrued Substate")   --   -- remove any destructed addresses-  destroyedAddresses <- use (#tx % #substate % #selfdestructs)+  destroyedAddresses <- use (#tx % #subState % #selfdestructs)   modifying (#env % #contracts)     (Map.filterWithKey (\k _ -> (k `notElem` destroyedAddresses)))   -- then, clear any remaining empty and touched addresses-  touchedAddresses <- use (#tx % #substate % #touchedAccounts)+  touchedAddresses <- use (#tx % #subState % #touchedAccounts)   modifying (#env % #contracts)     (Map.filterWithKey       (\k a -> not ((k `elem` touchedAddresses) && accountEmpty a)))@@ -1437,21 +1587,21 @@ forceAddr n msg continue = case wordToAddr n of   Nothing -> do     vm <- get-    partial $ UnexpectedSymbolicArg vm.state.pc msg (wrap [n])+    partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg (wrap [n])   Just c -> continue c  forceConcrete :: VMOps t => Expr EWord -> String -> (W256 -> EVM t s ()) -> EVM t s () forceConcrete n msg continue = case maybeLitWord n of   Nothing -> do     vm <- get-    partial $ UnexpectedSymbolicArg vm.state.pc msg (wrap [n])+    partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg (wrap [n])   Just c -> continue c  forceConcreteAddr :: VMOps t => Expr EAddr -> String -> (Addr -> EVM t s ()) -> EVM t s () forceConcreteAddr n msg continue = case maybeLitAddr n of   Nothing -> do     vm <- get-    partial $ UnexpectedSymbolicArg vm.state.pc msg (wrap [n])+    partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg (wrap [n])   Just c -> continue c  forceConcreteAddr2 :: VMOps t => (Expr EAddr, Expr EAddr) -> String -> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()@@ -1459,39 +1609,39 @@   (Just c, Just d) -> continue (c,d)   _ -> do     vm <- get-    partial $ UnexpectedSymbolicArg vm.state.pc msg (wrap [n, m])+    partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg (wrap [n, m])  forceConcrete2 :: VMOps t => (Expr EWord, Expr EWord) -> String -> ((W256, W256) -> EVM t s ()) -> EVM t s () forceConcrete2 (n,m) msg continue = case (maybeLitWord n, maybeLitWord m) of   (Just c, Just d) -> continue (c, d)   _ -> do     vm <- get-    partial $ UnexpectedSymbolicArg vm.state.pc msg (wrap [n, m])+    partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg (wrap [n, m])  forceConcreteBuf :: VMOps t => Expr Buf -> String -> (ByteString -> EVM t s ()) -> EVM t s () forceConcreteBuf (ConcreteBuf b) _ continue = continue b forceConcreteBuf b msg _ = do     vm <- get-    partial $ UnexpectedSymbolicArg vm.state.pc msg (wrap [b])+    partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg (wrap [b])  -- * Substate manipulation refund :: Word64 -> EVM t s () refund n = do   self <- use (#state % #contract)-  pushTo (#tx % #substate % #refunds) (self, n)+  pushTo (#tx % #subState % #refunds) (self, n)  unRefund :: Word64 -> EVM t s () unRefund n = do   self <- use (#state % #contract)-  refs <- use (#tx % #substate % #refunds)-  assign (#tx % #substate % #refunds)+  refs <- use (#tx % #subState % #refunds)+  assign (#tx % #subState % #refunds)     (filter (\(a,b) -> not (a == self && b == n)) refs)  touchAccount :: Expr EAddr -> EVM t s ()-touchAccount = pushTo ((#tx % #substate) % #touchedAccounts)+touchAccount = pushTo ((#tx % #subState) % #touchedAccounts)  selfdestruct :: Expr EAddr -> EVM t s ()-selfdestruct = pushTo ((#tx % #substate) % #selfdestructs)+selfdestruct = pushTo ((#tx % #subState) % #selfdestructs)  accessAndBurn :: VMOps t => Expr EAddr -> EVM t s () -> EVM t s () accessAndBurn x cont = do@@ -1504,20 +1654,20 @@ -- otherwise cold accessAccountForGas :: Expr EAddr -> EVM t s Bool accessAccountForGas addr = do-  accessedAddrs <- use (#tx % #substate % #accessedAddresses)+  accessedAddrs <- use (#tx % #subState % #accessedAddresses)   let accessed = member addr accessedAddrs-  assign (#tx % #substate % #accessedAddresses) (insert addr accessedAddrs)+  assign (#tx % #subState % #accessedAddresses) (insert addr accessedAddrs)   pure accessed  -- | returns a wrapped boolean- if true, this slot has been touched before in the txn (warm gas cost as in EIP 2929) -- otherwise cold accessStorageForGas :: Expr EAddr -> Expr EWord -> EVM t s Bool accessStorageForGas addr key = do-  accessedStrkeys <- use (#tx % #substate % #accessedStorageKeys)+  accessedStrkeys <- use (#tx % #subState % #accessedStorageKeys)   case maybeLitWord key of     Just litword -> do       let accessed = member (addr, litword) accessedStrkeys-      assign (#tx % #substate % #accessedStorageKeys) (insert (addr, litword) accessedStrkeys)+      assign (#tx % #subState % #accessedStorageKeys) (insert (addr, litword) accessedStrkeys)       pure accessed     _ -> pure False @@ -1532,185 +1682,341 @@  cheat   :: (?op :: Word8, VMOps t)-  => (Expr EWord, Expr EWord) -> (Expr EWord, Expr EWord)+  => Gas t -> (Expr EWord, Expr EWord) -> (Expr EWord, Expr EWord) -> [Expr EWord]   -> EVM t s ()-cheat (inOffset, inSize) (outOffset, outSize) = do+cheat gas (inOffset, inSize) (outOffset, outSize) xs = do   vm <- get   input <- readMemory (Expr.add inOffset (Lit 4)) (Expr.sub inSize (Lit 4))+  calldata <- readMemory inOffset inSize   abi <- readBytes 4 (Lit 0) <$> readMemory inOffset (Lit 4)-  pushTrace $ FrameTrace (CallContext cheatCode cheatCode inOffset inSize (Lit 0) (maybeLitWord abi) input vm.env.contracts vm.tx.substate)+  let newContext = CallContext cheatCode cheatCode outOffset outSize (Lit 0) (maybeLitWord abi) calldata vm.env.contracts vm.tx.subState++  pushTrace $ FrameTrace newContext+  next+  vm1 <- get+  burn' gas $ pushTo #frames $ Frame+                    { state = vm1.state { stack = xs }+                    , context = newContext+                    }   case maybeLitWord abi of-    Nothing -> partial $ UnexpectedSymbolicArg vm.state.pc "symbolic cheatcode selector" (wrap [abi])+    Nothing -> partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) "symbolic cheatcode selector" (wrap [abi])     Just (unsafeInto -> abi') ->       case Map.lookup abi' cheatActions of-        Nothing ->-          vmError (BadCheatCode abi')-        Just action -> do-            action outOffset outSize input-            popTrace-            next-            push 1+        Nothing -> vmError (BadCheatCode "Cannot understand cheatcode." abi')+        Just action -> action input -type CheatAction t s = Expr EWord -> Expr EWord -> Expr Buf -> EVM t s ()+type CheatAction t s = Expr Buf -> EVM t s ()  cheatActions :: VMOps t => Map FunctionSelector (CheatAction t s)-cheatActions =-  Map.fromList-    [ action "ffi(string[])" $-        \sig outOffset outSize input -> do-          vm <- get-          if vm.config.allowFFI then-            case decodeBuf [AbiArrayDynamicType AbiStringType] input of-              CAbi valsArr -> case valsArr of-                [AbiArrayDynamic AbiStringType strsV] ->-                  let-                    cmd = fmap-                            (\case-                              (AbiString a) -> unpack $ decodeUtf8 a-                              _ -> "")-                            (V.toList strsV)-                    cont bs = do-                      let encoded = ConcreteBuf bs-                      assign (#state % #returndata) encoded-                      copyBytesToMemory encoded outSize (Lit 0) outOffset-                      assign #result Nothing-                  in query (PleaseDoFFI cmd cont)-                _ -> vmError (BadCheatCode sig)-              _ -> vmError (BadCheatCode sig)-          else-            let msg = "ffi disabled: run again with --ffi if you want to allow tests to call external scripts"-            in partial $ UnexpectedSymbolicArg vm.state.pc msg [],+cheatActions = Map.fromList+  [ action "ffi(string[])" $+      \sig input -> do+        vm <- get+        if vm.config.allowFFI then+          case decodeBuf [AbiArrayDynamicType AbiStringType] input of+            CAbi valsArr -> case valsArr of+              [AbiArrayDynamic AbiStringType strsV] ->+                let+                  cmd = fmap+                          (\case+                            (AbiString a) -> toString a+                            _ -> "")+                          (V.toList strsV)+                  cont bs = continueOnce $ do+                    frameReturnBuf bs+                in query (PleaseDoFFI cmd vm.osEnv cont)+              _ -> vmError (BadCheatCode "ffi(string[]) decoding of string failed" sig)+            _ -> vmError (BadCheatCode "ffi(string[]) parameter decoding failed" sig)+        else+          let msg = "ffi disabled: run again with --ffi if you want to allow tests to call external scripts"+          in partial $ UnexpectedSymbolicArg vm.state.pc (getOpName vm.state) msg [] -      action "warp(uint256)" $-        \sig _ _ input -> case decodeStaticArgs 0 1 input of-          [x]  -> assign (#block % #timestamp) x-          _ -> vmError (BadCheatCode sig),+  , action "warp(uint256)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [x]  -> do+          assign (#block % #timestamp) x+          doStop+        _ -> vmError (BadCheatCode "warp(uint256) parameter decoding failed" sig) -      action "deal(address,uint256)" $-        \sig _ _ input -> case decodeStaticArgs 0 2 input of-          [a, amt] ->-            forceAddr a "vm.deal: cannot decode target into an address" $ \usr ->-              fetchAccount usr $ \_ -> do-                assign (#env % #contracts % ix usr % #balance) amt-          _ -> vmError (BadCheatCode sig),+  , action "deal(address,uint256)" $+      \sig input -> case decodeStaticArgs 0 2 input of+        [a, amt] ->+          forceAddr a "vm.deal: cannot decode target into an address" $ \usr ->+            fetchAccount usr $ \_ -> do+              assign (#env % #contracts % ix usr % #balance) amt+              doStop+        _ -> vmError (BadCheatCode "deal(address,uint256) parameter decoding failed" sig) -      action "assume(bool)" $-        \sig _ _ input -> case decodeStaticArgs 0 1 input of-          [c] -> modifying #constraints ((:) (PEq c (Lit 1)))-          _ -> vmError (BadCheatCode sig),+  , action "assume(bool)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [c] -> do+          modifying #constraints ((:) (PEq (Lit 1) c))+          doStop+        _ -> vmError (BadCheatCode "assume(bool) parameter decoding failed." sig) -      action "roll(uint256)" $-        \sig _ _ input -> case decodeStaticArgs 0 1 input of-          [x] -> forceConcrete x "cannot roll to a symbolic block number" (assign (#block % #number))-          _ -> vmError (BadCheatCode sig),+  , action "roll(uint256)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [x] -> forceConcrete x "cannot roll to a symbolic block number" $ \block -> do+          assign (#block % #number) block+          doStop+        _ -> vmError (BadCheatCode "roll(uint256) parameter decoding failed" sig) -      action "store(address,bytes32,bytes32)" $-        \sig _ _ input -> case decodeStaticArgs 0 3 input of-          [a, slot, new] -> case wordToAddr a of-            Just a'@(LitAddr _) -> fetchAccount a' $ \_ ->-              modifying (#env % #contracts % ix a' % #storage) (writeStorage slot new)-            _ -> vmError (BadCheatCode sig)-          _ -> vmError (BadCheatCode sig),+  , action "store(address,bytes32,bytes32)" $+      \sig input -> case decodeStaticArgs 0 3 input of+        [a, slot, new] -> case wordToAddr a of+          Just a'@(LitAddr _) -> fetchAccount a' $ \_ -> do+            modifying (#env % #contracts % ix a' % #storage) (writeStorage slot new)+            doStop+          _ -> vmError (BadCheatCode "store(address,bytes32,bytes32) issue, address provided may not be an address?" sig)+        _ -> vmError (BadCheatCode "store(address,bytes32,bytes32) parameter decoding failed" sig) -      action "load(address,bytes32)" $-        \sig outOffset _ input -> case decodeStaticArgs 0 2 input of-          [a, slot] -> case wordToAddr a of-            Just a'@(LitAddr _) -> fetchAccount a' $ \_ ->-              accessStorage a' slot $ \res -> do-                assign (#state % #returndata % word256At (Lit 0)) res-                let buf = writeWord (Lit 0) res (ConcreteBuf "")-                copyBytesToMemory buf (Lit 32) (Lit 0) outOffset-            _ -> vmError (BadCheatCode sig)-          _ -> vmError (BadCheatCode sig),+  , action "load(address,bytes32)" $+      \sig input -> case decodeStaticArgs 0 2 input of+        [a, slot] -> case wordToAddr a of+          Just a'@(LitAddr _) -> fetchAccount a' $ \_ ->+            accessStorage a' slot $ \res -> do+              let buf = writeWord (Lit 0) res (ConcreteBuf "")+              frameReturnExpr buf -- TODO reivew+          _ -> vmError (BadCheatCode "load(address,bytes32) issue, maybe the address provided is not correct?" sig)+        _ -> vmError (BadCheatCode "load(address,bytes32) parameter decoding failed" sig) -      action "sign(uint256,bytes32)" $-        \sig outOffset _ input -> case decodeStaticArgs 0 2 input of-          [sk, hash] ->-            forceConcrete2 (sk, hash) "cannot sign symbolic data" $ \(sk', hash') -> do-              let (v,r,s) = EVM.Sign.sign hash' (into sk')-                  encoded = encodeAbiValue $-                    AbiTuple (V.fromList-                      [ AbiUInt 8 $ into v-                      , AbiBytes 32 (word256Bytes r)-                      , AbiBytes 32 (word256Bytes s)-                      ])-              assign (#state % #returndata) (ConcreteBuf encoded)-              copyBytesToMemory (ConcreteBuf encoded) (Lit . unsafeInto . BS.length $ encoded) (Lit 0) outOffset-          _ -> vmError (BadCheatCode sig),+  , action "sign(uint256,bytes32)" $+      \sig input -> case decodeStaticArgs 0 2 input of+        [sk, hash] ->+          forceConcrete2 (sk, hash) "cannot sign symbolic data" $ \(sk', hash') -> do+            let (v,r,s) = EVM.Sign.sign hash' (into sk')+                result = AbiTuple $+                  V.fromList+                    [ AbiUInt 8 $ into v+                    , AbiBytes 32 (word256Bytes r)+                    , AbiBytes 32 (word256Bytes s)+                    ]+            frameReturn result -- TODO ??+        _ -> vmError (BadCheatCode "sign(uint256,bytes32) parameter decoding failed" sig) -      action "addr(uint256)" $-        \sig outOffset _ input -> case decodeStaticArgs 0 1 input of-          [sk] -> forceConcrete sk "cannot derive address for a symbolic key" $ \sk' -> do-            let a = EVM.Sign.deriveAddr $ into sk'-            case a of-              Nothing -> vmError (BadCheatCode sig)-              Just address -> do-                let expAddr = litAddr address-                assign (#state % #returndata % word256At (Lit 0)) expAddr-                let buf = ConcreteBuf $ word256Bytes (into address)-                copyBytesToMemory buf (Lit 32) (Lit 0) outOffset-          _ -> vmError (BadCheatCode sig),+  , action "addr(uint256)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [sk] -> forceConcrete sk "cannot derive address for a symbolic key" $ \sk' -> do+          case EVM.Sign.deriveAddr $ into sk' of+            Nothing -> vmError (BadCheatCode "addr(uint256) could not derive address" sig)+            Just address -> do frameReturnBuf $ word256Bytes (into address) -- TODO ??+        _ -> vmError (BadCheatCode "addr(uint256) parameter decoding failed" sig) -      action "prank(address)" $-        \sig _ _ input -> case decodeStaticArgs 0 1 input of-          [addr]  -> case wordToAddr addr of-            Just a -> assign (#config % #overrideCaller) (Just a)-            Nothing -> vmError (BadCheatCode sig)-          _ -> vmError (BadCheatCode sig),+  , action "prank(address)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [addr]  -> case wordToAddr addr of+          Just a -> do+            doStop+            assign (#state % #overrideCaller) (Just a)+            assign (#state % #resetCaller) True+          Nothing -> vmError (BadCheatCode "prank(address), could not decode address provided" sig)+        _ -> vmError (BadCheatCode "prank(address) parameter decoding failed" sig) -      action "createFork(string)" $-        \sig outOffset _ input -> case decodeBuf [AbiStringType] input of-          CAbi valsArr -> case valsArr of-            [AbiString bytes] -> do-              forkId <- length <$> gets (.forks)-              let urlOrAlias = Char8.unpack bytes-              modify' $ \vm -> vm { forks = vm.forks Seq.|> ForkState vm.env vm.block vm.cache urlOrAlias }-              let encoded = encodeAbiValue $ AbiUInt 256 (fromIntegral forkId)-              assign (#state % #returndata) (ConcreteBuf encoded)-              copyBytesToMemory (ConcreteBuf encoded) (Lit . unsafeInto . BS.length $ encoded) (Lit 0) outOffset-            _ -> vmError (BadCheatCode sig)-          _ -> vmError (BadCheatCode sig),+  , action "startPrank(address)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [addr]  -> case wordToAddr addr of+          Just a -> do+            doStop+            assign (#state % #overrideCaller) (Just a)+            assign (#state % #resetCaller) False+          Nothing -> vmError (BadCheatCode "startPrank(address), could not decode address provided" sig)+        _ -> vmError (BadCheatCode "startPrank(address) parameter decoding failed" sig) -      action "selectFork(uint256)" $-        \sig _ _ input -> case decodeStaticArgs 0 1 input of-          [forkId] ->-            forceConcrete forkId "forkId must be concrete" $ \(fromIntegral -> forkId') -> do-              saved <- Seq.lookup forkId' <$> gets (.forks)-              case saved of-                Just forkState -> do-                  vm <- get-                  let contractAddr = vm.state.contract-                  let callerAddr = vm.state.caller-                  fetchAccount contractAddr $ \contractAcct -> fetchAccount callerAddr $ \callerAcct -> do-                    let-                      -- the current contract is persisted across forks-                      newContracts = Map.insert callerAddr callerAcct $-                                     Map.insert contractAddr contractAcct forkState.env.contracts-                      newEnv = (forkState.env :: Env) { contracts = newContracts }+  , action "stopPrank()" $+      \_ _ -> do+        doStop+        assign (#state % #overrideCaller) Nothing+        assign (#state % #resetCaller) False -                    when (vm.currentFork /= forkId') $ do-                      modify' $ \vm' -> vm'-                        { env = newEnv-                        , block = forkState.block-                        , forks = Seq.adjust' (\state -> (state :: ForkState)-                            { env = vm.env, block = vm.block, cache = vm.cache }-                          ) vm.currentFork  vm.forks-                        , currentFork = forkId'-                        }-                Nothing ->-                  vmError (NonexistentFork forkId')-          _ -> vmError (BadCheatCode sig),+  , action "createFork(string)" $+      \sig input -> case decodeBuf [AbiStringType] input of+        CAbi valsArr -> case valsArr of+          [AbiString bytes] -> do+            forkId <- length <$> gets (.forks)+            let urlOrAlias = Char8.unpack bytes+            modify' $ \vm -> vm { forks = vm.forks Seq.|> ForkState vm.env vm.block vm.cache urlOrAlias }+            frameReturn $ AbiUInt 256 (fromIntegral forkId)+          _ -> vmError (BadCheatCode "createFork(string) string provided may be incorrect?" sig)+        _ -> vmError (BadCheatCode "createFork(string) parameter decoding failed" sig) -      action "activeFork()" $-        \_ outOffset _ _ -> do-          vm <- get-          let encoded = encodeAbiValue $ AbiUInt 256 (fromIntegral vm.currentFork)-          assign (#state % #returndata) (ConcreteBuf encoded)-          copyBytesToMemory (ConcreteBuf encoded) (Lit . unsafeInto . BS.length $ encoded) (Lit 0) outOffset-    ]+  , action "selectFork(uint256)" $+      \sig input -> case decodeStaticArgs 0 1 input of+        [forkId] ->+          forceConcrete forkId "forkId of 'selectFork' must be concrete" $ \(fromIntegral -> forkId') -> do+            saved <- Seq.lookup forkId' <$> gets (.forks)+            case saved of+              Just forkState -> do+                vm <- get+                let contractAddr = vm.state.contract+                let callerAddr = vm.state.caller+                fetchAccount contractAddr $ \contractAcct -> fetchAccount callerAddr $ \callerAcct -> do+                  let+                    -- the current contract is persisted across forks+                    newContracts = Map.insert callerAddr callerAcct $+                                   Map.insert contractAddr contractAcct forkState.env.contracts+                    newEnv = (forkState.env :: Env) { contracts = newContracts }++                  when (vm.currentFork /= forkId') $ do+                    modify' $ \vm' -> vm'+                      { env = newEnv+                      , block = forkState.block+                      , forks = Seq.adjust' (\state -> (state :: ForkState)+                          { env = vm.env, block = vm.block, cache = vm.cache }+                        ) vm.currentFork  vm.forks+                      , currentFork = forkId'+                      }+                  doStop+              Nothing ->+                vmError (NonexistentFork forkId')+        _ -> vmError (BadCheatCode "selectFork(uint256) parameter decoding failed" sig)++  , action "activeFork()" $+      \_ _ -> do+        vm <- get+        frameReturn $ AbiUInt 256 (fromIntegral vm.currentFork)++  , action "label(address,string)" $+      \sig input -> case decodeBuf [AbiAddressType, AbiStringType] input of+        CAbi valsArr -> case valsArr of+          [AbiAddress addr, AbiString label] -> do+            #labels %= Map.insert addr (decodeUtf8 label)+            doStop+          _ -> vmError (BadCheatCode "label(address,string) address decoding failed" sig)+        _ -> vmError (BadCheatCode "label(address,string) parameter decoding failed" sig)++  , action "setEnv(string,string)" $+      \sig input -> case decodeBuf [AbiStringType, AbiStringType] input of+        CAbi valsArr -> case valsArr of+          [AbiString variable, AbiString value] -> do+            let (varStr, varVal) = (toString variable, toString value)+            #osEnv %= Map.insert varStr varVal+            doStop+          _ -> vmError (BadCheatCode "setEnv(string,string) address decoding failed" sig)+        _ -> vmError (BadCheatCode "setEnv(string,string) parameter decoding failed" sig)++  -- Single-value environment read cheat actions+  , $(envReadSingleCheat "envBool(string)") AbiBool stringToBool+  , $(envReadSingleCheat "envUint(string)") (AbiUInt 256) stringToWord256+  , $(envReadSingleCheat "envInt(string)") (AbiInt 256) stringToInt256+  , $(envReadSingleCheat "envAddress(string)") AbiAddress stringToAddress+  , $(envReadSingleCheat "envBytes32(string)") (AbiBytes 32) stringToBytes32+  , $(envReadSingleCheat "envString(string)") (\x -> AbiTuple $ V.fromList [AbiString x]) stringToByteString+  , $(envReadSingleCheat "envBytes(bytes)") (\x -> AbiTuple $ V.fromList [AbiBytesDynamic x]) stringHexToByteString++  -- Multi-value environment read cheat actions+  , $(envReadMultipleCheat "envBool(string,string)" AbiBoolType) stringToBool+  , $(envReadMultipleCheat "envUint(string,string)" $ AbiUIntType 256) stringToWord256+  , $(envReadMultipleCheat "envInt(string,string)" $ AbiIntType 256) stringToInt256+  , $(envReadMultipleCheat "envAddress(string,string)" AbiAddressType) stringToAddress+  , $(envReadMultipleCheat "envBytes32(string,string)" $ AbiBytesType 32) stringToBytes32+  , $(envReadMultipleCheat "envString(string,string)" AbiStringType) stringToByteString+  , $(envReadMultipleCheat "envBytes(bytes,bytes)" AbiBytesDynamicType) stringHexToByteString+  , action "assertTrue(bool)" $ \sig input ->+      case decodeBuf [AbiBoolType] input of+        CAbi [AbiBool True] -> doStop+        CAbi [AbiBool False] -> frameRevert "assertion failed"+        SAbi [eword] -> case (Expr.simplify (Expr.iszero eword)) of+          Lit 1 -> frameRevert "assertion failed"+          Lit 0 -> doStop+          ew -> branch ew $ \case+            True -> frameRevert "assertion failed"+            False -> doStop+        k -> vmError $ BadCheatCode ("assertTrue(bool) parameter decoding failed: " <> show k) sig+  , action "assertFalse(bool)" $ \sig input ->+      case decodeBuf [AbiBoolType] input of+        CAbi [AbiBool False] -> doStop+        CAbi [AbiBool True] -> frameRevert "assertion failed"+        SAbi [eword] -> case (Expr.simplify (Expr.iszero eword)) of+          Lit 0 -> frameRevert "assertion failed"+          Lit 1 -> doStop+          ew -> branch ew $ \case+            False -> frameRevert "assertion failed"+            True -> doStop+        k -> vmError $ BadCheatCode ("assertFalse(bool) parameter decoding failed: " <> show k) sig+  , action "assertEq(bool,bool)"       $ assertEq AbiBoolType+  , action "assertEq(uint256,uint256)" $ assertEq (AbiUIntType 256)+  , action "assertEq(int256,int256)"   $ assertEq (AbiIntType 256)+  , action "assertEq(address,address)" $ assertEq AbiAddressType+  , action "assertEq(bytes32,bytes32)" $ assertEq (AbiBytesType 32)+  , action "assertEq(string,string)"   $ assertEq (AbiStringType)+  --+  , action "assertNotEq(bool,bool)"       $ assertNotEq AbiBoolType+  , action "assertNotEq(uint256,uint256)" $ assertNotEq (AbiUIntType 256)+  , action "assertNotEq(int256,int256)"   $ assertNotEq (AbiIntType 256)+  , action "assertNotEq(address,address)" $ assertNotEq AbiAddressType+  , action "assertNotEq(bytes32,bytes32)" $ assertNotEq (AbiBytesType 32)+  , action "assertNotEq(string,string)"   $ assertNotEq (AbiStringType)+  --+  , action "assertLt(uint256,uint256)" $ assertLt (AbiUIntType 256)+  , action "assertLt(int256,int256)"   $ assertLt (AbiIntType 256)+  , action "assertLe(uint256,uint256)" $ assertLe (AbiUIntType 256)+  , action "assertLe(int256,int256)"   $ assertLe (AbiIntType 256)+  , action "assertGt(uint256,uint256)" $ assertGt (AbiUIntType 256)+  , action "assertGt(int256,int256)"   $ assertGt (AbiIntType 256)+  , action "assertGe(uint256,uint256)" $ assertGe (AbiUIntType 256)+  , action "assertGe(int256,int256)"   $ assertGe (AbiIntType 256)+  ]   where     action s f = (abiKeccak s, f (abiKeccak s))+    either' v l r = either l r v+    frameReturn :: VMOps t => AbiValue -> EVM t s ()+    frameReturn v = frameReturnBuf $ encodeAbiValue v+    frameReturnBuf :: VMOps t => ByteString -> EVM t s ()+    frameReturnBuf buf = frameReturnExpr $ ConcreteBuf buf+    frameReturnExpr :: VMOps t => Expr Buf -> EVM t s ()+    frameReturnExpr e = finishFrame (FrameReturned e)+    frameRevert :: VMOps t => ByteString -> EVM t s ()+    frameRevert err = finishFrame (FrameReverted $ errorMsg err)+    errorMsg :: ByteString -> Expr Buf+    errorMsg err = ConcreteBuf $ selector "Error(string)" <> encodeAbiValue (AbiTuple $ V.fromList [AbiString err])+    continueOnce cont = do+      assign #result Nothing+      cont+    doStop = finishFrame (FrameReturned mempty)+    toString = unpack . decodeUtf8+    strip0x s = if "0x" `isPrefixOf` s then drop 2 s else s+    stringToBool :: String -> Either ByteString Bool+    stringToBool s = case s of+      "true" -> Right True+      "True" -> Right True+      "false" -> Right False+      "False" -> Right False+      _ -> Left "invalid value"+    stringToWord256 :: String -> Either ByteString Word256+    stringToWord256 s = maybeToEither "invalid W256 value" $ readMaybe s+    stringToInt256 :: String -> Either ByteString Int256+    stringToInt256 s = maybeToEither "invalid Int256 value" $ readMaybe s+    stringToAddress :: String -> Either ByteString Addr+    stringToAddress s = fmap Addr $ maybeToEither "invalid address value" $ readMaybe s+    stringToBytes32 :: String -> Either ByteString ByteString+    stringToBytes32 s = fmap word256Bytes $ maybeToEither "invalid bytes32 value" $ readMaybe s+    stringToByteString :: String -> Either ByteString ByteString+    stringToByteString = Right . Char8.pack+    stringHexToByteString :: String -> Either ByteString ByteString+    stringHexToByteString s = either (const $ Left "invalid bytes value") Right $ BS16.decodeBase16Untyped . Char8.pack . strip0x $ s+    paramDecodeErr abitype name abivals = name <> "(" <> (show abitype) <> "," <> (show abitype) <>+      ")  parameter decoding failed. Error: " <> show abivals+    revertErr a b comp = frameRevert $ "assertion failed: " <>+      BS8.pack (show a) <> " " <> comp <> " " <> BS8.pack (show b)+    genAssert comp exprComp invComp name abitype sig input = do+      case decodeBuf [abitype, abitype] input of+        CAbi [a, b] | a `comp` b -> doStop+        CAbi [a, b] -> revertErr a b invComp+        SAbi [ew1, ew2] -> case (Expr.simplify (Expr.iszero $ exprComp ew1 ew2)) of+          Lit 0 -> doStop+          Lit _ -> revertErr ew1 ew2 invComp+          ew -> branch ew $ \case+            False -> doStop+            True -> revertErr ew1 ew2 invComp+        abivals -> vmError (BadCheatCode (paramDecodeErr abitype name abivals) sig)+    assertEq = genAssert (==) Expr.eq "!=" "assertEq"+    assertNotEq = genAssert (/=) (\a b -> Expr.iszero $ Expr.eq a b) "==" "assertNotEq"+    assertLt = genAssert (<) Expr.lt ">=" "assertLt"+    assertGt = genAssert (>) Expr.gt "<=" "assertGt"+    assertLe = genAssert (<=) Expr.leq ">" "assertLe"+    assertGe = genAssert (>=) Expr.geq "<" "assertGe" + -- * General call implementation ("delegateCall") -- note that the continuation is ignored in the precompile case delegateCall@@ -1733,16 +2039,18 @@           \(xTo', xContext') ->             precompiledContract this gasGiven xTo' xContext' xValue xInOffset xInSize xOutOffset xOutSize xs   | xTo == cheatCode = do-      assign (#state % #stack) xs-      cheat (xInOffset, xInSize) (xOutOffset, xOutSize)+      cheat gasGiven (xInOffset, xInSize) (xOutOffset, xOutSize) xs   | otherwise =       callChecks this gasGiven xContext xTo xValue xInOffset xInSize xOutOffset xOutSize xs $         \xGas -> do+          resetCaller <- use $ #state % #resetCaller+          when resetCaller $ assign (#state % #overrideCaller) Nothing           vm0 <- get           fetchAccount xTo $ \target -> case target.code of               UnknownCode _ -> do                 pc <- use (#state % #pc)-                partial $ UnexpectedSymbolicArg pc "call target has unknown code" (wrap [xTo])+                state <- use #state+                partial $ UnexpectedSymbolicArg pc (getOpName state) "call target has unknown code" (wrap [xTo])               _ -> do                 burn' xGas $ do                   calldata <- readMemory xInOffset xInSize@@ -1754,14 +2062,13 @@                                     , size      = xOutSize                                     , codehash  = target.codehash                                     , callreversion = vm0.env.contracts-                                    , subState  = vm0.tx.substate+                                    , subState  = vm0.tx.subState                                     , abi                                     , calldata                                     }                   pushTrace (FrameTrace newContext)                   next                   vm1 <- get-                   pushTo #frames $ Frame                     { state = vm1.state { stack = xs }                     , context = newContext@@ -1782,6 +2089,8 @@                     assign #memorySize 0                     assign #returndata mempty                     assign #calldata calldata+                    assign #overrideCaller Nothing+                    assign #resetCaller False                   continue xTo  -- -- * Contract creation@@ -1836,7 +2145,7 @@       False -> burn' xGas $ do         case parseInitCode initCode of           Nothing ->-            partial $ UnexpectedSymbolicArg vm0.state.pc "initcode must have a concrete prefix" []+            partial $ UnexpectedSymbolicArg vm0.state.pc (getOpName vm0.state) "initcode must have a concrete prefix" []           Just c -> do             let               newContract = initialContract c@@ -1844,7 +2153,7 @@                 CreationContext { address   = newAddr                                 , codehash  = newContract.codehash                                 , createreversion = vm0.env.contracts-                                , substate  = vm0.tx.substate+                                , subState  = vm0.tx.subState                                 }              zoom (#env % #contracts) $ do@@ -1865,6 +2174,7 @@              modifying (#env % #contracts % ix newAddr % #storage) resetStorage             modifying (#env % #contracts % ix newAddr % #origStorage) resetStorage+            modifying (#tx % #subState % #createdContracts) (insert newAddr)              transfer self newAddr xValue @@ -1979,14 +2289,10 @@     nextFrame : remainingFrames -> do        -- Insert a debug trace.-      insertTrace $-        case how of-          FrameErrored e ->-            ErrorTrace e-          FrameReverted e ->-            ErrorTrace (Revert e)-          FrameReturned output ->-            ReturnTrace output nextFrame.context+      insertTrace $ case how of+        FrameReturned output -> ReturnTrace output nextFrame.context+        FrameReverted e -> ErrorTrace (Revert e)+        FrameErrored e -> ErrorTrace e       -- Pop to the previous level of the debug trace stack.       popTrace @@ -2000,7 +2306,7 @@       case nextFrame.context of          -- Were we calling?-        CallContext _ _ outOffset outSize _ _ _ reversion substate' -> do+        CallContext _ _ outOffset outSize _ _ _ reversion subState' -> do            -- Excerpt K.1. from the yellow paper:           -- K.1. Deletion of an Account Despite Out-of-gas.@@ -2009,12 +2315,12 @@           -- Against the equation (197), this added 0x03 in the set of touched addresses, and this transaction turned σ[0x03] into ∅.            -- In other words, we special case address 0x03 and keep it in the set of touched accounts during revert-          touched <- use (#tx % #substate % #touchedAccounts)+          touched <- use (#tx % #subState % #touchedAccounts)            let-            substate'' = over #touchedAccounts (maybe id cons (find (LitAddr 3 ==) touched)) substate'+            subState'' = over #touchedAccounts (maybe id cons (find (LitAddr 3 ==) touched)) subState'             revertContracts = assign (#env % #contracts) reversion-            revertSubstate  = assign (#tx % #substate) substate''+            revertSubstate  = assign (#tx % #subState) subState''            case how of             -- Case 1: Returning from a call?@@ -2040,12 +2346,12 @@               assign (#state % #returndata) mempty               push 0         -- Or were we creating?-        CreationContext _ _ reversion substate' -> do+        CreationContext _ _ reversion subState' -> do           creator <- use (#state % #contract)           let             createe = oldVm.state.contract             revertContracts = assign (#env % #contracts) reversion'-            revertSubstate  = assign (#tx % #substate) substate'+            revertSubstate  = assign (#tx % #subState) subState'              -- persist the nonce through the reversion             reversion' = (Map.adjust (over #nonce (fmap ((+) 1))) creator) reversion@@ -2066,6 +2372,7 @@                     Nothing -> partial $                       UnexpectedSymbolicArg                         oldVm.state.pc+                        (getOpName oldVm.state)                         "runtime code cannot have an abstract length"                         (wrap [output])                     Just newCode -> do@@ -2229,16 +2536,16 @@ traceForest vm = zipperRootForest vm.traces  traceForest' :: Expr End -> Forest Trace-traceForest' (Success _ (Traces f _) _ _) = f-traceForest' (Partial _ (Traces f _) _) = f-traceForest' (Failure _ (Traces f _) _) = f+traceForest' (Success _ (TraceContext f _ _) _ _) = f+traceForest' (Partial _ (TraceContext f _ _) _) = f+traceForest' (Failure _ (TraceContext f _ _) _) = f traceForest' (ITE {}) = internalError"Internal Error: ITE does not contain a trace" traceForest' (GVar {}) = internalError"Internal Error: Unexpected GVar" -traceContext :: Expr End -> Map (Expr EAddr) Contract-traceContext (Success _ (Traces _ c) _ _) = c-traceContext (Partial _ (Traces _ c) _) = c-traceContext (Failure _ (Traces _ c) _) = c+traceContext :: Expr End -> TraceContext+traceContext (Success _ c _ _) = c+traceContext (Partial _ c _) = c+traceContext (Failure _ c _) = c traceContext (ITE {}) = internalError"Internal Error: ITE does not contain a trace" traceContext (GVar {}) = internalError"Internal Error: Unexpected GVar" @@ -2753,7 +3060,7 @@     gasRemaining <- use (#state % #gas)      let-      sumRefunds   = sum (snd <$> tx.substate.refunds)+      sumRefunds   = sum (snd <$> tx.subState.refunds)       gasUsed      = tx.gaslimit - gasRemaining       cappedRefund = min (quot gasUsed 5) sumRefunds       originPay    = (into $ gasRemaining + cappedRefund) * tx.gasprice

src/EVM/ABI.hs view

@@ -55,6 +55,7 @@   , makeAbiValue   , parseAbiValue   , selector+  , showAlter   ) where  import EVM.Expr (readWord, isLitWord)@@ -84,6 +85,7 @@ import Data.Word (Word32) import GHC.Generics (Generic) import Test.QuickCheck hiding ((.&.), label)+import Numeric (showHex)  import Text.Megaparsec qualified as P import Text.Megaparsec.Char qualified as P@@ -108,6 +110,9 @@   | AbiFunction     BS.ByteString   deriving (Read, Eq, Ord, Generic) +class ShowAlter a where+  showAlter :: a -> String+ -- | Pretty-print some 'AbiValue'. instance Show AbiValue where   show (AbiUInt _ n)         = show n@@ -125,6 +130,24 @@     "(" ++ intercalate ", " (show <$> Vector.toList v) ++ ")"   show (AbiFunction b)       = show (ByteStringS b) +-- | Pretty-print some 'AbiValue'.+instance ShowAlter AbiValue where+  showAlter (AbiUInt _ n)         = "AbiUint " <> showHex n ""+  showAlter (AbiInt  _ n)         = if n < 0 then "AbiInt- " <> showHex (-n) ""+                                             else "AbiInt+ " <> showHex n ""+  showAlter (AbiAddress n)        = "AbiAddress " <> show n+  showAlter (AbiBool b)           = "AbiBool " <> if b then "true" else "false"+  showAlter (AbiBytes      _ b)   = "AbiBytes " <> show (ByteStringS b)+  showAlter (AbiBytesDynamic b)   = "AbiBytesDynamic " <>show (ByteStringS b)+  showAlter (AbiString       s)   = "AbiString " <> formatString s+  showAlter (AbiArrayDynamic _ v) = "AbiArrayDynamic " <>+    "[" ++ intercalate ", " (show <$> Vector.toList v) ++ "]"+  showAlter (AbiArray      _ _ v) = "AbiArray " <>+    "[" ++ intercalate ", " (showAlter <$> Vector.toList v) ++ "]"+  showAlter (AbiTuple v) = "AbiTuple" <>+    "(" ++ intercalate ", " (show <$> Vector.toList v) ++ ")"+  showAlter (AbiFunction b)       = "AbiFunction " <> show (ByteStringS b)+ data AbiType   = AbiUIntType         Int   | AbiIntType          Int@@ -321,9 +344,9 @@         _ -> internalError "impossible"  putAbiSeq :: Vector AbiValue -> Put-putAbiSeq xs =-  do putHeads headSize $ toList xs-     Vector.sequence_ (putAbiTail <$> xs)+putAbiSeq xs = do+  putHeads headSize $ toList xs+  Vector.sequence_ (putAbiTail <$> xs)   where     headSize = Vector.sum $ Vector.map abiHeadSize xs     putHeads _ [] = pure ()@@ -471,7 +494,7 @@ bytesP = do   _ <- string "0x"   hex <- munch isHexDigit-  case BS16.decodeBase16 (encodeUtf8 (Text.pack hex)) of+  case BS16.decodeBase16Untyped (encodeUtf8 (Text.pack hex)) of     Right d -> pure $ ByteStringS d     Left _ -> pfail @@ -479,26 +502,23 @@   deriving (Show)  decodeBuf :: [AbiType] -> Expr Buf -> AbiVals-decodeBuf tps (ConcreteBuf b)-  = case runGetOrFail (getAbiSeq (length tps) tps) (BSLazy.fromStrict b) of-      Right ("", _, args) -> CAbi (toList args)-      _ -> NoVals-decodeBuf tps buf-  = if containsDynamic tps-    then NoVals-    else let+decodeBuf tps (ConcreteBuf b) =+  case runGetOrFail (getAbiSeq (length tps) tps) (BSLazy.fromStrict b) of+    Right ("", _, args) -> CAbi (toList args)+    _ -> NoVals+decodeBuf tps buf =+  if any isDynamic tps then NoVals+  else+    let       vs = decodeStaticArgs 0 (length tps) buf-      allLit = Prelude.and (fmap isLitWord vs)       asBS = mconcat $ fmap word256Bytes (mapMaybe maybeLitWord vs)-    in if not allLit+    in if not (all isLitWord vs)        then SAbi vs        else case runGetOrFail (getAbiSeq (length tps) tps) (BSLazy.fromStrict asBS) of          Right ("", _, args) -> CAbi (toList args)          _ -> NoVals-   where     isDynamic t = abiKind t == Dynamic-    containsDynamic = or . fmap isDynamic  decodeStaticArgs :: Int -> Int -> Expr Buf -> [Expr EWord] decodeStaticArgs offset numArgs b =@@ -524,11 +544,11 @@    AbiStringType ->      AbiString . BS.pack <$> listOf arbitrary    AbiArrayDynamicType t ->-     do xs <- listOf1 (scale (`div` 2) (genAbiValue t))+     do xs <- listOf1 (scale (`div` 3) (genAbiValue t))         pure (AbiArrayDynamic t (Vector.fromList xs))    AbiArrayType n t ->      AbiArray n t . Vector.fromList <$>-       replicateM n (scale (`div` 2) (genAbiValue t))+       replicateM n (scale (`div` 3) (genAbiValue t))    AbiTupleType ts ->      AbiTuple <$> mapM genAbiValue ts    AbiFunctionType ->@@ -590,6 +610,6 @@            bits n | n `quot` 2 == 0 = 0                   | otherwise = 1 + bits (n `quot` 2)            k  = 2^(s*(bits mn `max` bits mx `max` 40) `div` 100)-       smol <- choose (toInteger mn `max` (-k), toInteger mx `min` k)+       smol <- choose (into mn `max` (-k), mx `min` k)        mid <- choose (0, maxbound)        elements [fromIntegral smol, fromIntegral mid, fromIntegral (maxbound - (fromIntegral smol))]

src/EVM/Assembler.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- {-| Module      : Assembler Description : Assembler for EVM opcodes used in the HEVM symbolic checker@@ -70,12 +68,17 @@       OpChainid -> [LitByte 0x46]       OpSelfbalance -> [LitByte 0x47]       OpBaseFee -> [LitByte 0x48]+      OpBlobhash -> [LitByte 0x49]+      OpBlobBaseFee -> [LitByte 0x4A]       OpPop -> [LitByte 0x50]+      OpMcopy -> [LitByte 0x5e]       OpMload -> [LitByte 0x51]       OpMstore -> [LitByte 0x52]       OpMstore8 -> [LitByte 0x53]       OpSload -> [LitByte 0x54]       OpSstore -> [LitByte 0x55]+      OpTload -> [LitByte 0x5c]+      OpTstore -> [LitByte 0x5d]       OpJump -> [LitByte 0x56]       OpJumpi -> [LitByte 0x57]       OpPc -> [LitByte 0x58]

src/EVM/CSE.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- {- |     Module: EVM.CSE     Description: Common subexpression elimination for Expr ast

+ src/EVM/CheatsTH.hs view

@@ -0,0 +1,72 @@+{-# LANGUAGE TemplateHaskell #-}++module EVM.CheatsTH where++import EVM.ABI+import EVM.Types (internalError)++import Data.ByteString.Char8 (pack)+import Data.Map.Strict qualified as Map+import Data.Vector qualified as V++import Language.Haskell.TH+import Language.Haskell.TH.Syntax++liftByteString :: String -> Q Exp+liftByteString txt = AppE (VarE 'pack) <$> lift txt++liftAbiType :: AbiType -> Q Exp+liftAbiType AbiBoolType = [| AbiBool |]+liftAbiType (AbiUIntType n) = [| AbiUInt $(lift n) |]+liftAbiType (AbiIntType n) = [| AbiInt $(lift n) |]+liftAbiType AbiAddressType = [| AbiAddress |]+liftAbiType (AbiBytesType n) = [| AbiBytes $(lift n) |]+liftAbiType AbiStringType = [| AbiString |]+liftAbiType AbiBytesDynamicType = [| AbiBytesDynamic |]+liftAbiType _ = internalError "unimplemented"++envReadSingleCheat :: String -> Q Exp+envReadSingleCheat sigString = [|+  \wrap convert ->+    action $sigL $+      \sig input -> case decodeBuf [AbiStringType] input of+        CAbi [AbiString variable] -> let+          varStr = toString variable+          cont value = continueOnce $ do+            either' (convert value) frameRevert $ \v ->+              frameReturn $ wrap v+          in do+            vm <- get+            case Map.lookup varStr vm.osEnv of+              Just v -> cont v+              Nothing -> query (PleaseReadEnv varStr cont)+        _ -> vmError (BadCheatCode (sigString <> " parameter decoding failed") sig)+   |]+  where+    sigL = liftByteString sigString++envReadMultipleCheat :: String -> AbiType -> Q Exp+envReadMultipleCheat sigString arrType = [|+  \convert ->+    action $sigL $+      \sig input -> case decodeBuf [AbiStringType, AbiStringType] input of+        CAbi [AbiString variable, AbiString delimiter] -> let+          (varStr, delimStr) = (toString variable, toString delimiter)+          cont value = continueOnce $ do+            let (errors, values) = partitionEithers $ map convert $ splitOn delimStr value+            case errors of+              [] -> do+                let result = AbiTuple $ V.fromList [AbiArrayDynamic $arrTypeL $ V.fromList $ map $wrapL values]+                frameReturn result+              (e:_) -> frameRevert e+          in do+            vm <- get+            case Map.lookup varStr vm.osEnv of+              Just v -> cont v+              Nothing -> query (PleaseReadEnv varStr cont)+        _ -> vmError (BadCheatCode (sigString <> " parameter decoding failed") sig)+  |]+  where+    sigL = liftByteString sigString+    arrTypeL = liftData arrType+    wrapL = liftAbiType arrType

src/EVM/Concrete.hs view

@@ -1,5 +1,3 @@-{-# Language DataKinds #-}- module EVM.Concrete where  import Prelude hiding (Word)

src/EVM/Dapp.hs view

@@ -1,5 +1,3 @@-{-# Language DataKinds #-}- module EVM.Dapp where  import EVM.ABI@@ -45,7 +43,8 @@  data DappContext = DappContext   { info :: DappInfo-  , env  :: Map (Expr EAddr) Contract+  , contracts :: Map (Expr EAddr) Contract+  , labels :: Map Addr Text   }  dappInfo :: FilePath -> BuildOutput -> DappInfo@@ -101,7 +100,7 @@   | "check" `isPrefixOf` testname = Just (Sig testname argtypes)   | otherwise = Nothing   where-    testname = method.methodSignature+    testname = method.name     argtypes = snd <$> method.inputs  findUnitTests :: Text -> ([SolcContract] -> [(Text, [Sig])])

src/EVM/Effects.hs view

@@ -14,28 +14,13 @@ [1]: https://www.fpcomplete.com/blog/readert-design-pattern/ -} -{-# Language RankNTypes #-}-{-# Language FlexibleInstances #-}-{-# Language KindSignatures #-}-{-# Language DataKinds #-}-{-# Language GADTs #-}-{-# Language DerivingStrategies #-}-{-# Language DuplicateRecordFields #-}-{-# Language NoFieldSelectors #-}-{-# Language ConstraintKinds #-}- module EVM.Effects where  import Control.Monad.Reader import Control.Monad.IO.Unlift-import EVM.Dapp (DappInfo)-import EVM.Types (VM(..))-import Control.Monad.ST (RealWorld) import Data.Text (Text) import Data.Text.IO qualified as T import System.IO (stderr)-import EVM.Format (showTraceTree)-import EVM (traceForest)   -- Abstract Effects --------------------------------------------------------------------------------@@ -47,18 +32,17 @@   readConfig ::  m Config  data Config = Config-  { dumpQueries     :: Bool-  , dumpExprs       :: Bool-  , dumpEndStates   :: Bool-  , debug           :: Bool-  , abstRefineArith :: Bool-  , abstRefineMem   :: Bool-  , dumpTrace       :: Bool-  , numCexFuzz      :: Integer+  { dumpQueries      :: Bool+  , dumpExprs        :: Bool+  , dumpEndStates    :: Bool+  , debug            :: Bool+  , dumpTrace        :: Bool+  , numCexFuzz       :: Integer    -- Used to debug fuzzer in test.hs. It disables the SMT solver    -- and uses the fuzzer ONLY to try to find a counterexample.    -- Returns Unknown if the Cex cannot be found via fuzzing-  , onlyCexFuzz     :: Bool+  , onlyCexFuzz      :: Bool+  , decomposeStorage :: Bool   }   deriving (Show, Eq) @@ -68,28 +52,16 @@   , dumpExprs = False   , dumpEndStates = False   , debug = False-  , abstRefineArith = False-  , abstRefineMem   = False   , dumpTrace = False   , numCexFuzz = 10   , onlyCexFuzz  = False+  , decomposeStorage = True   }  -- Write to the console 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/Exec.hs view

@@ -41,6 +41,8 @@     , create = False     , txAccessList = mempty     , allowFFI = False+    , freshAddresses = 0+    , beaconRoot = 0     }) <&> set (#env % #contracts % at (LitAddr ethrunAddress))              (Just (initialContract (RuntimeCode (ConcreteRuntimeCode ""))))

src/EVM/Expr.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE PatternSynonyms #-}  {-|@@ -8,7 +7,9 @@ module EVM.Expr where  import Prelude hiding (LT, GT)-import Control.Monad.ST+import Control.Monad (unless, when)+import Control.Monad.ST (ST)+import Control.Monad.State (put, get, modify, execState, State) import Data.Bits hiding (And, Xor) import Data.ByteString (ByteString) import Data.ByteString qualified as BS@@ -17,6 +18,7 @@ import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe, isJust, fromMaybe) import Data.Semigroup (Any, Any(..), getAny)+import Data.Typeable import Data.Vector qualified as V import Data.Vector (Vector) import Data.Vector.Mutable qualified as MV@@ -24,9 +26,8 @@ import Data.Vector.Storable qualified as VS import Data.Vector.Storable.ByteString import Data.Word (Word8, Word32)-import Witch (unsafeInto, into, tryFrom)+import Witch (unsafeInto, into, tryFrom, tryInto) import Data.Containers.ListUtils (nubOrd)-import Control.Monad.State  import Optics.Core @@ -106,13 +107,13 @@ addmod = op3 AddMod (\x y z ->   if z == 0   then 0-  else fromIntegral $ (to512 x + to512 y) `Prelude.mod` to512 z)+  else fromIntegral $ (into @Word512 x + into y) `Prelude.mod` into z)  mulmod :: Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord mulmod = op3 MulMod (\x y z ->-   if z == 0-   then 0-   else fromIntegral $ (to512 x * to512 y) `Prelude.mod` to512 z)+  if z == 0+  then 0+  else fromIntegral $ (into @Word512 x * into y) `Prelude.mod` into z)  exp :: Expr EWord -> Expr EWord -> Expr EWord exp = op2 Exp (^)@@ -199,6 +200,17 @@      else        fromIntegral $ shiftR asSigned (fromIntegral x)) ++-- Props++peq :: (Typeable a) => Expr a -> Expr a -> Prop+peq (Lit x) (Lit y) = PBool (x == y)+peq a@(Lit _) b = PEq a b+peq a b@(Lit _) = PEq b a -- we always put concrete values on LHS+peq a b+  | a == b = PBool True+  | otherwise = PEq a b+ -- ** Bufs ** --------------------------------------------------------------------------------------  @@ -279,12 +291,12 @@ -- returns an abstract ReadWord expression if a concrete word cannot be constructed readWordFromBytes :: Expr EWord -> Expr Buf -> Expr EWord readWordFromBytes (Lit idx) (ConcreteBuf bs) =-  case toInt idx of-    Nothing -> Lit 0-    Just i -> Lit $ word $ padRight 32 $ BS.take 32 $ BS.drop i bs+  case tryInto idx of+    Left _ -> Lit 0+    Right i -> Lit $ word $ padRight 32 $ BS.take 32 $ BS.drop i bs readWordFromBytes i@(Lit idx) buf = let     bytes = [readByte (Lit i') buf | i' <- [idx .. idx + 31]]-  in if Prelude.and . (fmap isLitByte) $ bytes+  in if all isLitByte bytes      then Lit (bytesToW256 . mapMaybe maybeLitByte $ bytes)      else ReadWord i buf readWordFromBytes idx buf = ReadWord idx buf@@ -309,26 +321,18 @@ maxBytes :: W256 maxBytes = into (maxBound :: Word32) `Prelude.div` 8 +maxWord256 :: W256+maxWord256 = W256 (maxBound :: Word256)+ copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Expr Buf -> Expr Buf -> Expr Buf --- Copies from empty buffers-copySlice _ _ (Lit 0) (ConcreteBuf "") dst = dst-copySlice a b c@(Lit size) d@(ConcreteBuf "") e@(ConcreteBuf "")-  | size < maxBytes = ConcreteBuf $ BS.replicate (unsafeInto size) 0-  | otherwise = CopySlice a b c d e-copySlice srcOffset dstOffset sz@(Lit size) src@(ConcreteBuf "") dst-  | size < maxBytes = copySlice srcOffset dstOffset (Lit size) (ConcreteBuf $ BS.replicate (unsafeInto size) 0) dst-  | otherwise = CopySlice srcOffset dstOffset sz src dst+-- Copying zero bytes is a no-op+copySlice _ _ (Lit 0) _ dst = dst --- Fully concrete copies-copySlice a@(Lit srcOffset) b@(Lit dstOffset) c@(Lit size) d@(ConcreteBuf src) e@(ConcreteBuf "")-  | srcOffset > unsafeInto (BS.length src), size < maxBytes = ConcreteBuf $ BS.replicate (unsafeInto size) 0-  | srcOffset <= unsafeInto (BS.length src), dstOffset < maxBytes, size < maxBytes = let-    hd = BS.replicate (unsafeInto dstOffset) 0-    sl = padRight (unsafeInto size) $ BS.take (unsafeInto size) (BS.drop (unsafeInto srcOffset) src)-    in ConcreteBuf $ hd <> sl-  | otherwise = CopySlice a b c d e+-- copying 32 bytes can be rewritten to a WriteWord on dst (e.g. CODECOPY of args during constructors)+copySlice srcOffset dstOffset (Lit 32) src dst = writeWord dstOffset (readWord srcOffset src) dst +-- Fully concrete copy copySlice a@(Lit srcOffset) b@(Lit dstOffset) c@(Lit size) d@(ConcreteBuf src) e@(ConcreteBuf dst)   | dstOffset < maxBytes   , size < maxBytes =@@ -340,9 +344,6 @@       in ConcreteBuf $ hd <> sl <> tl   | otherwise = CopySlice a b c d e --- copying 32 bytes can be rewritten to a WriteWord on dst (e.g. CODECOPY of args during constructors)-copySlice srcOffset dstOffset (Lit 32) src dst = writeWord dstOffset (readWord srcOffset src) dst- -- concrete indices & abstract src (may produce a concrete result if we are -- copying from a concrete region of src) copySlice s@(Lit srcOffset) d@(Lit dstOffset) sz@(Lit size) src ds@(ConcreteBuf dst)@@ -424,6 +425,7 @@     go l (AbstractBuf b) = EVM.Expr.max l (BufLength (AbstractBuf b))     go l (WriteWord idx _ b) = go (EVM.Expr.max l (add idx (Lit 32))) b     go l (WriteByte idx _ b) = go (EVM.Expr.max l (add idx (Lit 1))) b+    go l (CopySlice _ _ (Lit 0) _ dst) = go l dst     go l (CopySlice _ dstOffset size _ dst) = go (EVM.Expr.max l (add dstOffset size)) dst      go l (GVar (BufVar a)) | useEnv =@@ -607,6 +609,13 @@ -- no explicit writes to the requested slot. This makes implementing rpc -- storage lookups much easier. If the store is backed by an AbstractStore we -- always return a symbolic value.+--+-- This does not strip writes that cannot possibly match a read, in case there are+-- some write(s) in between that it cannot statically determine to be removable, because+-- it will early-abort. So (load idx1 (store idx1 (store idx1 (store idx0)))) will not strip+-- the idx0 store, in case things in between cannot be stripped. See simplify-storage-map-todo+-- test for an example where this happens. Note that decomposition solves this, though late in+-- the simplification lifecycle (just before SMT generation, which can be too late) readStorage :: Expr EWord -> Expr Storage -> Maybe (Expr EWord) readStorage w st = go (simplify w) st   where@@ -623,16 +632,16 @@       (Lit _, Lit _) -> go slot prev        -- slot is for a map + map -> skip write-      (MappingSlot idA _, MappingSlot idB _)     | idsDontMatch idA idB  -> go slot prev-      (MappingSlot _ keyA, MappingSlot _ keyB)   | surelyNotEq keyA keyB -> go slot prev+      (MappingSlot idA _, MappingSlot idB _)       | BS.length idB == 64 && BS.length idA == 64 && idsDontMatch idA idB  -> go slot prev+      (MappingSlot idA keyA, MappingSlot idB keyB) | BS.length idB == 64 && BS.length idA == 64 && surelyNotEq keyA keyB -> go slot prev        -- special case of array + map -> skip write-      (ArraySlotWithOffset idA _, Keccak64Bytes) | BS.length idA /= 64 -> go slot prev-      (ArraySlotZero idA, Keccak64Bytes)         | BS.length idA /= 64 -> go slot prev+      (ArraySlotWithOffs idA _, Keccak   k)      | bufLength k == Lit 64 && BS.length idA == 32 -> go slot prev+      (ArraySlotZero idA, Keccak k)              | bufLength k == Lit 64 && BS.length idA == 32 -> go slot prev -      -- special case of array + map -> skip write-      (Keccak64Bytes, ArraySlotWithOffset idA _) | BS.length idA /= 64 -> go slot prev-      (Keccak64Bytes, ArraySlotZero idA)         | BS.length idA /= 64 -> go slot prev+      -- special case of map + array -> skip write+      (Keccak k, ArraySlotWithOffs idA _)      | bufLength k == Lit 64 && BS.length idA == 32 -> go slot prev+      (ArraySlotWithOffs idA _, Keccak k)      | bufLength k == Lit 64 && BS.length idA == 32 -> go slot prev        -- Fixed SMALL value will never match Keccak (well, it might, but that's VERY low chance)       (Lit a, Keccak _) | a < 256 -> go slot prev@@ -652,23 +661,23 @@        -- Finding two Keccaks that are < 256 away from each other should be VERY hard       -- This simplification allows us to deal with maps of structs-      (Add (Lit a2) (Keccak _), Add (Lit b2) (Keccak _)) | a2 /= b2, abs(a2-b2) < 256 -> go slot prev+      (Add (Lit a2) (Keccak _), Add (Lit b2) (Keccak _)) | a2 /= b2, abs (a2-b2) < 256 -> go slot prev       (Add (Lit a2) (Keccak _), (Keccak _)) | a2 > 0, a2 < 256 -> go slot prev       ((Keccak _), Add (Lit b2) (Keccak _)) | b2 > 0, b2 < 256 -> go slot prev        -- case of array + array, but different id's or different concrete offsets       -- zero offs vs zero offs-      (ArraySlotZero idA, ArraySlotZero idB)                   | idA /= idB -> go slot prev+      (ArraySlotZero idA, ArraySlotZero idB)                   | BS.length idA == 32, BS.length idB == 32, idA /= idB -> go slot prev       -- zero offs vs non-zero offs-      (ArraySlotZero idA, ArraySlotWithOffset idB _)           | idA /= idB -> go slot prev-      (ArraySlotZero _, ArraySlotWithOffset _ (Lit offB))      | offB /= 0  -> go slot prev+      (ArraySlotZero idA, ArraySlotWithOffs idB _)             | BS.length idA == 32, BS.length idB == 32, idA /= idB -> go slot prev+      (ArraySlotZero idA, ArraySlotWithOffs idB (Lit offB))    | BS.length idA == 32, BS.length idB == 32, offB /= 0  -> go slot prev       -- non-zero offs vs zero offs-      (ArraySlotWithOffset idA _, ArraySlotZero idB)           | idA /= idB -> go slot prev-      (ArraySlotWithOffset _ (Lit offA), ArraySlotZero _)      | offA /= 0  -> go slot prev+      (ArraySlotWithOffs idA _, ArraySlotZero idB)             | BS.length idA == 32, BS.length idB == 32, idA /= idB -> go slot prev+      (ArraySlotWithOffs idA (Lit offA), ArraySlotZero idB)    | BS.length idA == 32, BS.length idB == 32, offA /= 0  -> go slot prev       -- non-zero offs vs non-zero offs-      (ArraySlotWithOffset idA _, ArraySlotWithOffset idB _)   | idA /= idB -> go slot prev+      (ArraySlotWithOffs idA _, ArraySlotWithOffs idB _)       | BS.length idA == 32, BS.length idB == 32, idA /= idB -> go slot prev -      (ArraySlotWithOffset _ offA, ArraySlotWithOffset _ offB) | surelyNotEq offA offB -> go slot prev+      (ArraySlotWithOffs idA offA, ArraySlotWithOffs idB offB) | BS.length idA == 32, BS.length idB == 32, surelyNotEq offA offB -> go slot prev        -- we are unable to determine statically whether or not we can safely move deeper in the write chain, so return an abstract term       _ -> Just $ SLoad slot s@@ -687,16 +696,12 @@  -- storage slots for maps are determined by (keccak (bytes32(key) ++ bytes32(id))) pattern MappingSlot :: ByteString -> Expr EWord -> Expr EWord-pattern MappingSlot id key = Keccak (CopySlice (Lit 0) (Lit 0) (Lit 64) (WriteWord (Lit 0) key (ConcreteBuf id)) (ConcreteBuf ""))---- keccak of any 64 bytes value-pattern Keccak64Bytes :: Expr EWord-pattern Keccak64Bytes <- Keccak (CopySlice (Lit 0) (Lit 0) (Lit 64) _ (ConcreteBuf ""))+pattern MappingSlot idx key = Keccak (WriteWord (Lit 0) key (ConcreteBuf idx))  -- storage slots for arrays are determined by (keccak(bytes32(id)) + offset) -- note that `normArgs` puts the Lit as the 2nd argument to `Add`-pattern ArraySlotWithOffset :: ByteString -> Expr EWord -> Expr EWord-pattern ArraySlotWithOffset id offset = Add (Keccak (ConcreteBuf id)) offset+pattern ArraySlotWithOffs :: ByteString -> Expr EWord -> Expr EWord+pattern ArraySlotWithOffs id offset = Add (Keccak (ConcreteBuf id)) offset  -- special pattern to match the 0th element because the `Add` term gets simplified out pattern ArraySlotZero :: ByteString -> Expr EWord@@ -721,7 +726,7 @@   where     go :: Expr a -> Expr a     go orig@(Lit key) = case litToArrayPreimage key of-      Just (array, offset) -> ArraySlotWithOffset (slotPos array) (Lit offset)+      Just (array, offset) -> ArraySlotWithOffs (slotPos array) (Lit offset)       _ -> orig     go a = a @@ -777,23 +782,48 @@ data StorageType = SmallSlot | Array | Map | Mixed | UNK   deriving (Show, Eq) -safeToDecompose :: Expr a -> Bool-safeToDecompose inp = result /= Mixed+-- We can't currently decompose cases when the FULL returned state is equated+-- This is because the decomposition would need to take into account that ALL+-- maps/arrays/small-slots need to be equivalent. This could be done, but is left+-- as a TODO. Currently this only affects equivalence checking as there is no+-- EVM bytecode to compare the FULL state, so such comparison could only be+-- generated via hevm itself+safeToDecomposeProp :: Prop -> Bool+safeToDecomposeProp p = isJust $ mapPropM' findPEqStore p   where+    findPEqStore :: Prop -> Maybe Prop+    findPEqStore = \case+      (PEq (SStore {}) (SStore {})) -> Nothing+      (PEq (AbstractStore {}) (SStore {})) -> Nothing+      (PEq (SStore {}) (AbstractStore {})) -> Nothing+      (PEq (AbstractStore {}) (AbstractStore {})) -> Nothing+      a -> Just a++-- This checks if the decomposition is possible by making sure there is no+-- mixture of different types of accesses such as array/map/small-slot.+safeToDecompose :: Expr a -> Maybe ()+safeToDecompose inp = if result /= Mixed then Just () else Nothing+  where     result = execState (safeToDecomposeRunner inp) UNK      safeToDecomposeRunner :: forall a. Expr a -> State StorageType ()     safeToDecomposeRunner a = go a      go :: forall b. Expr b -> State StorageType ()-    go e@(SLoad (MappingSlot {}) _) = setMap e-    go e@(SLoad (ArraySlotZero {}) _) = setArray e-    go e@(SLoad (ArraySlotWithOffset {}) _) = setArray e+    go e@(SLoad (MappingSlot x _) _) = if BS.length x == 64 then setMap e else setMixed e+    go e@(SLoad (Keccak x) _) = case bufLength x of+                                  Lit 32 -> setArray e+                                  Lit 64 -> setMap e+                                  _ -> setMixed e+    go e@(SLoad (ArraySlotWithOffs x _) _) = if BS.length x == 32 then setArray e else setMixed e     go e@(SLoad (Lit x) _) | x < 256 = setSmall e     go e@(SLoad _ _) = setMixed e-    go e@(SStore (MappingSlot {}) _ _) = setMap e-    go e@(SStore (ArraySlotZero {}) _ _) = setArray e-    go e@(SStore (ArraySlotWithOffset {}) _ _) = setArray e+    go e@(SStore (MappingSlot x _) _ _) = if BS.length x == 64 then setMap e else setMixed e+    go e@(SStore (Keccak x) _ _) =  case bufLength x of+                                  Lit 32 -> setArray e+                                  Lit 64 -> setMap e+                                  _ -> setMixed e+    go e@(SStore (ArraySlotWithOffs x _) _ _) = if BS.length x == 32 then setArray e else setMixed e     go e@(SStore (Lit x) _ _) | x < 256 = setSmall e     go e@(SStore _ _ _) = setMixed e     go _ = pure ()@@ -828,9 +858,9 @@       pure ()  -- | Splits storage into logical sub-stores if (1) all SLoad->SStore* chains are one of:---     (1a) Lit < 256, (1b) MappingSlot, (1c) ArraySlotWithOffset, (1d) ArraySlotZero+--     (1a) Lit < 256, (1b) MappingSlot, (1c) ArraySlotWithOffs, (1d) ArraySlotZero --  and (2) there is no mixing of different types (e.g. Map with Array) within---  the same SStore -> SLoad* chain, and (3) there is no mixing of different array/map slots.+--  the same SStore -> SLoad* chain -- --  Mixing (2) and (3) are attempted to be prevented (if possible) as part of the rewrites --  done by the `readStorage` function that is ran before this. If there is still mixing here,@@ -843,7 +873,7 @@ decomposeStorage = go   where     go :: Expr a -> Maybe (Expr a)-    go e@(SLoad origKey store) = if Prelude.not (safeToDecompose e) then Nothing else tryRewrite origKey store+    go (SLoad key store) = tryRewrite key store     go e = Just e      tryRewrite :: Expr EWord -> Expr Storage -> Maybe (Expr EWord)@@ -859,8 +889,14 @@     inferLogicalIdx = \case       Lit a | a >= 256 -> Nothing       Lit a -> Just (Nothing, Lit a)+      -- maps+      (Keccak (ConcreteBuf k)) | BS.length k == 64 -> do+        let key = idxToWord (BS.take 32 k)+            idx = Lit $ idxToWord (BS.drop 32 k)+        Just (Just key, idx)       (MappingSlot idx key) | BS.length idx == 64 -> Just (Just $ idxToWord idx, key)-      (ArraySlotWithOffset idx offset) | BS.length idx == 32 -> Just (Just $ idxToWord64 idx, offset)+      -- arrays+      (ArraySlotWithOffs idx offset) | BS.length idx == 32 -> Just (Just $ idxToWord64 idx, offset)       (ArraySlotZero idx) | BS.length idx == 32 -> Just (Just $ idxToWord64 idx, Lit 0)       _ -> Nothing @@ -873,12 +909,16 @@     -- Updates the logical base store of the given expression if it is safe to do so     setLogicalBase :: Maybe W256 -> Expr Storage -> Maybe (Expr Storage) -    -- abstract bases get their logical idx set to the new value-    setLogicalBase idx (AbstractStore addr _) = Just $ AbstractStore addr idx-    setLogicalBase idx (SStore i v s) = do-      b <- setLogicalBase idx s-      (idx2, key2) <- inferLogicalIdx i-      if idx == idx2 then Just (SStore key2 v b) else Nothing+    setLogicalBase idx (AbstractStore addr Nothing) = Just $ AbstractStore addr idx+    setLogicalBase idx (AbstractStore addr idx2) | idx == idx2 = Just $ AbstractStore addr idx+    setLogicalBase _ (AbstractStore _ _) = internalError "we only rewrite idx once, on load"+    setLogicalBase idx (SStore k v prevStorage) = do+      (idx2, key2) <- inferLogicalIdx k+      b <- setLogicalBase idx prevStorage+      -- If it's not the same IDX, we can skip. This is possible because there are no+      -- mixed arrays/maps/small-slots, as checked by safeToDecompose+      if idx == idx2 then Just (SStore key2 v b)+      else setLogicalBase idx b      -- empty concrete base is safe to reuse without any rewriting     setLogicalBase _ s@(ConcreteStore m) | Map.null m = Just s@@ -909,9 +949,6 @@     go (CopySlice (Lit 0x0) (Lit 0x0) (Lit 0x0) _ dst) = dst      -- simplify storage-    go (Keccak (ConcreteBuf bs)) = case BS.length bs == 64 of-      True -> MappingSlot bs (Lit $ word bs)-      False -> Keccak (ConcreteBuf bs)     go (SLoad slot store) = readStorage' slot store     go (SStore slot val store) = writeStorage slot val store @@ -936,6 +973,10 @@      go (WriteByte a b c) = writeByte a b c +    -- eliminate a CopySlice if the resulting buffer is the same as the src buffer+    go (CopySlice (Lit 0) (Lit 0) (Lit s) src (ConcreteBuf ""))+      | bufLength src == (Lit s) = src+     -- truncate some concrete source buffers to the portion relevant for the CopySlice if we're copying a fully concrete region     go orig@(CopySlice srcOff@(Lit n) dstOff size@(Lit sz)         -- It doesn't matter what wOffs we write to, because only the first@@ -958,20 +999,28 @@       | a < b = Lit 1       | otherwise = Lit 0     go (EVM.Types.LT _ (Lit 0)) = Lit 0+    go (EVM.Types.LT a (Lit 1)) = iszero a      -- normalize all comparisons in terms of LT     go (EVM.Types.GT a b) = lt b a     go (EVM.Types.GEq a b) = leq b a-    go (EVM.Types.LEq a b) = EVM.Types.IsZero (gt a b)-    go (IsZero a) = iszero a+    go (EVM.Types.LEq a b) = iszero (lt b a)     go (SLT a@(Lit _) b@(Lit _)) = slt a b     go (SGT a b) = SLT b a +    -- IsZero+    go (IsZero (IsZero (IsZero a))) = iszero a+    go (IsZero (IsZero (LT x y))) = lt x y+    go (IsZero (IsZero (Eq x y))) = eq x y+    go (IsZero (Xor x y)) = eq x y+    go (IsZero a) = iszero a+     -- syntactic Eq reduction     go (Eq (Lit a) (Lit b))       | a == b = Lit 1       | otherwise = Lit 0     go (Eq (Lit 0) (Sub a b)) = eq a b+    go (Eq (Lit 0) a) = iszero a     go (Eq a b)       | a == b = Lit 1       | otherwise = eq a b@@ -987,6 +1036,9 @@     -- literal addresses     go (WAddr (LitAddr a)) = Lit $ into a +    -- XOR normalization+    go (Xor a  b) = EVM.Expr.xor a b+     -- simple div/mod/add/sub     go (Div o1@(Lit _)  o2@(Lit _)) = EVM.Expr.div  o1 o2     go (SDiv o1@(Lit _) o2@(Lit _)) = EVM.Expr.sdiv o1 o2@@ -995,6 +1047,14 @@     go (Add o1@(Lit _)  o2@(Lit _)) = EVM.Expr.add  o1 o2     go (Sub o1@(Lit _)  o2@(Lit _)) = EVM.Expr.sub  o1 o2 +    -- Mod+    go (Mod _ (Lit 0)) = Lit 0+    go (SMod _ (Lit 0)) = Lit 0+    go (Mod a b) | a == b = Lit 0+    go (SMod a b) | a == b = Lit 0+    go (Mod (Lit 0) _) = Lit 0+    go (SMod (Lit 0) _) = Lit 0+     -- double add/sub.     -- Notice that everything is done mod 2**256. So for example:     -- (a-b)+c observes the same arithmetic equalities as we are used to@@ -1057,19 +1117,18 @@       | otherwise = o      -- Bitwise AND & OR. These MUST preserve bitwise equivalence-    go o@(And (Lit x) _)-      | x == 0 = Lit 0-      | otherwise = o-    go o@(And v (Lit x))-      | x == 0 = Lit 0-      | x == maxLit = v-      | otherwise = o-    go o@(Or (Lit x) b)-      | x == 0 = b-      | otherwise = o-    go o@(Or a (Lit x))-      | x == 0 = a-      | otherwise = o+    go (And a b)+      | a == b = a+      | b == (Not a) || a == (Not b) = Lit 0+      | a == (Lit 0) || b == (Lit 0) = Lit 0+      | a == (Lit maxLit) = b+      | b == (Lit maxLit) = a+      | otherwise = EVM.Expr.and a b+    go (Or a b)+      | a == b = a+      | a == (Lit 0) = b+      | b == (Lit 0) = a+      | otherwise = EVM.Expr.or a b      -- If x is ever non zero the Or will always evaluate to some non zero value and the false branch will be unreachable     -- NOTE: with AND this does not work, because and(0x8, 0x4) = 0@@ -1108,10 +1167,14 @@                      (Lit 1, _) -> b                      _ -> mul a b -    -- Some trivial div eliminations+    -- Some trivial (s)div eliminations     go (Div (Lit 0) _) = Lit 0 -- divide 0 by anything (including 0) is zero in EVM     go (Div _ (Lit 0)) = Lit 0 -- divide anything by 0 is zero in EVM     go (Div a (Lit 1)) = a+    go (SDiv (Lit 0) _) = Lit 0 -- divide 0 by anything (including 0) is zero in EVM+    go (SDiv _ (Lit 0)) = Lit 0 -- divide anything by 0 is zero in EVM+    go (SDiv a (Lit 1)) = a+    -- NOTE: Div x x is NOT 1, because Div 0 0 is 0, not 1.      -- If a >= b then the value of the `Max` expression can never be < b     go o@(LT (Max (Lit a) _) (Lit b))@@ -1133,10 +1196,10 @@   simplifyProps :: [Prop] -> [Prop]-simplifyProps ps = if canBeSat then simplified else [PBool False]+simplifyProps ps = if cannotBeSat then [PBool False] else simplified   where     simplified = remRedundantProps . map simplifyProp . flattenProps $ ps-    canBeSat = constFoldProp simplified+    cannotBeSat = isUnsat simplified  -- | Evaluate the provided proposition down to its most concrete result -- Also simplifies the inner Expr, if it exists@@ -1148,61 +1211,75 @@     go :: Prop -> Prop      -- LT/LEq comparisons+    go (PGT a b) = PLT b a+    go (PGEq a b) = PLEq b a     go (PLT  (Var _) (Lit 0)) = PBool False-    go (PLEq (Lit 0) (Var _)) = PBool True+    go (PLEq (Lit 0) _) = PBool True+    go (PLEq (WAddr _) (Lit 1461501637330902918203684832716283019655932542975)) = PBool True+    go (PLEq _ (Lit x)) | x == maxLit = PBool True     go (PLT  (Lit val) (Var _)) | val == maxLit = PBool False     go (PLEq (Var _) (Lit val)) | val == maxLit = PBool True     go (PLT (Lit l) (Lit r)) = PBool (l < r)     go (PLEq (Lit l) (Lit r)) = PBool (l <= r)     go (PLEq a (Max b _)) | a == b = PBool True     go (PLEq a (Max _ b)) | a == b = PBool True+    go (PLEq (Sub a b) c) | a == c = PLEq b a     go (PLT (Max (Lit a) b) (Lit c)) | a < c = PLT b (Lit c)-    go (PLT (Lit 0) (Eq a b)) = PEq a b+    go (PLT (Lit 0) (Eq a b)) = peq a b      -- negations     go (PNeg (PBool b)) = PBool (Prelude.not b)     go (PNeg (PNeg a)) = a      -- solc specific stuff-    go (PEq (IsZero (Eq a b)) (Lit 0)) = PEq a b-    go (PEq (IsZero (IsZero (Eq a b))) (Lit 0)) = PNeg (PEq a b)+    go (PEq (Lit 0) (IsZero (IsZero (Eq a b)))) = PNeg (peq a b)      -- iszero(a) -> (a == 0)     -- iszero(iszero(a))) -> ~(a == 0) -> a > 0     -- iszero(iszero(a)) == 0 -> ~~(a == 0) -> a == 0     -- ~(iszero(iszero(a)) == 0) -> ~~~(a == 0) -> ~(a == 0) -> a > 0-    go (PNeg (PEq (IsZero (IsZero a)) (Lit 0))) = PGT a (Lit 0)+    go (PNeg (PEq (Lit 0) (IsZero (IsZero a)))) = PLT (Lit 0) a      -- iszero(a) -> (a == 0)     -- iszero(a) == 0 -> ~(a == 0)     -- ~(iszero(a) == 0) -> ~~(a == 0) -> a == 0-    go (PNeg (PEq (IsZero a) (Lit 0))) = PEq a (Lit 0)+    go (PNeg (PEq (Lit 0) (IsZero a))) = peq (Lit 0) a      -- a < b == 0 -> ~(a < b)     -- ~(a < b == 0) -> ~~(a < b) -> a < b-    go (PNeg (PEq (LT a b) (Lit 0x0))) = PLT a b+    go (PNeg (PEq (Lit 0) (LT a b))) = PLT a b      -- And/Or     go (PAnd (PBool l) (PBool r)) = PBool (l && r)     go (PAnd (PBool False) _) = PBool False     go (PAnd _ (PBool False)) = PBool False+    go (PAnd (PBool True) x) = x+    go (PAnd x (PBool True)) = x     go (POr (PBool True) _) = PBool True     go (POr _ (PBool True)) = PBool True     go (POr (PBool l) (PBool r)) = PBool (l || r)+    go (POr x (PBool False)) = x+    go (POr (PBool False) x) = x      -- Imply     go (PImpl _ (PBool True)) = PBool True     go (PImpl (PBool True) b) = b     go (PImpl (PBool False) _) = PBool True +    -- Double negation+    go (PEq (Lit 0) (IsZero (Eq a b))) = peq a b+    go (PEq (Lit 0) (IsZero (LT a b))) = PLT a b+    go (PEq (Lit 0) (IsZero (GT a b))) = PGT a b+    go (PEq (Lit 0) (IsZero (LEq a b))) = PLEq a b+    go (PEq (Lit 0) (IsZero (GEq a b))) = PGEq a b+     -- Eq-    go (PEq (Eq a b) (Lit 0)) = PNeg (PEq a b)-    go (PEq (Eq a b) (Lit 1)) = PEq a b-    go (PEq (Sub a b) (Lit 0)) = PEq a b-    go (PEq (Lit l) (Lit r)) = PBool (l == r)-    go o@(PEq l r)-      | l == r = PBool True-      | otherwise = o+    go (PEq (Lit 0) (Eq a b)) = PNeg (peq a b)+    go (PEq (Lit 1) (Eq a b)) = peq a b+    go (PEq (Lit 0) (Sub a b)) = peq a b+    go (PEq (Lit 0) (LT a b)) = PLEq b a+    go (PEq l r) = peq l r+     go p = p  @@ -1227,7 +1304,7 @@ flattenProps :: [Prop] -> [Prop] flattenProps [] = [] flattenProps (a:ax) = case a of-  PAnd x1 x2 -> x1:x2:flattenProps ax+  PAnd x1 x2 -> flattenProps [x1] ++ flattenProps [x2] ++ flattenProps ax   x -> x:flattenProps ax  -- removes redundant (constant True/False) props@@ -1260,10 +1337,7 @@ litCode :: BS.ByteString -> [Expr Byte] litCode bs = fmap LitByte (BS.unpack bs) -to512 :: W256 -> Word512-to512 = fromIntegral - -- ** Helpers ** -----------------------------------------------------------------------------------  @@ -1465,32 +1539,26 @@   }   deriving (Show) --- | Folds constants-constFoldProp :: [Prop] -> Bool-constFoldProp ps = oneRun ps (ConstState mempty True)+-- | Checks if a conjunction of propositions is definitely unsatisfiable+isUnsat :: [Prop] -> Bool+isUnsat ps = Prelude.not $ oneRun ps (ConstState mempty True)   where     oneRun ps2 startState = (execState (mapM (go . simplifyProp) ps2) startState).canBeSat     go :: Prop -> State ConstState ()-    go x = case x of+    go = \case         -- PEq         PEq (Lit l) a -> do           s <- get           case Map.lookup a s.values of-            Just l2 -> case l==l2 of-                True -> pure ()-                False -> put ConstState {canBeSat=False, values=mempty}-            Nothing -> do-              let vs' = Map.insert a l s.values-              put $ s{values=vs'}+            Just l2 -> unless (l==l2) $ put ConstState {canBeSat=False, values=mempty}+            Nothing -> modify (\s' -> s'{values=Map.insert a l s'.values})         PEq a b@(Lit _) -> go (PEq b a)         -- PNeg         PNeg (PEq (Lit l) a) -> do           s <- get           case Map.lookup a s.values of-            Just l2 -> case l==l2 of-                True -> put ConstState {canBeSat=False, values=mempty}-                False -> pure ()-            Nothing -> pure()+            Just l2 -> when (l==l2) $ put ConstState {canBeSat=False, values=mempty}+            Nothing -> pure ()         PNeg (PEq a b@(Lit _)) -> go $ PNeg (PEq b a)         -- Others         PAnd a b -> do@@ -1501,10 +1569,8 @@           let             v1 = oneRun [a] s             v2 = oneRun [b] s-          when (Prelude.not v1) $ go b-          when (Prelude.not v2) $ go a-          s2 <- get-          put $ s{canBeSat=(s2.canBeSat && (v1 || v2))}+          unless v1 $ go b+          unless v2 $ go a         PBool False -> put $ ConstState {canBeSat=False, values=mempty}         _ -> pure () @@ -1528,3 +1594,25 @@     (64, ConcreteBuf a) -> Lit (keccak' a)     _ -> orig concKeccakOnePass x = x++lhsConstHelper :: Expr a -> Maybe ()+lhsConstHelper = go+  where+    go :: Expr a -> Maybe ()+    go (Mul _ (Lit _)) = Nothing+    go (Add _ (Lit _)) = Nothing+    go (Min _ (Lit _)) = Nothing+    go (Max _ (Lit _)) = Nothing+    go (Eq _ (Lit _))  = Nothing+    go (And _ (Lit _)) = Nothing+    go (Or _ (Lit _))  = Nothing+    go (Xor _ (Lit _)) = Nothing+    go _ = Just ()++-- Commutative operators should have the constant on the LHS+checkLHSConstProp :: Prop -> Bool+checkLHSConstProp a = isJust $ mapPropM_ lhsConstHelper a++-- Commutative operators should have the constant on the LHS+checkLHSConst :: Expr a -> Bool+checkLHSConst a = isJust $ mapExprM_ lhsConstHelper a

src/EVM/Fetch.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- module EVM.Fetch where  import EVM (initialContract, unknownContract)@@ -18,14 +16,15 @@ import Data.Aeson.Optics import Data.ByteString qualified as BS import Data.Text (Text, unpack, pack)+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe) import Data.List (foldl')-import Data.Text qualified as T import Data.Vector qualified as RegularVector import Network.Wreq import Network.Wreq.Session (Session) import Network.Wreq.Session qualified as Session import Numeric.Natural (Natural)+import System.Environment (lookupEnv, getEnvironment) import System.Process import Control.Monad.IO.Class import EVM.Effects@@ -186,21 +185,24 @@  http :: Natural -> Maybe Natural -> BlockNumber -> Text -> Fetcher t m s http smtjobs smttimeout n url q =-  withSolvers Z3 smtjobs smttimeout $ \s ->+  withSolvers Z3 smtjobs 1 smttimeout $ \s ->     oracle s (Just (n, url)) q  zero :: Natural -> Maybe Natural -> Fetcher t m s zero smtjobs smttimeout q =-  withSolvers Z3 smtjobs smttimeout $ \s ->+  withSolvers Z3 smtjobs 1 smttimeout $ \s ->     oracle s Nothing q  -- smtsolving + (http or zero) oracle :: SolverGroup -> RpcInfo -> Fetcher t m s oracle solvers info q = do   case q of-    PleaseDoFFI vals continue -> case vals of+    PleaseDoFFI vals envs continue -> case vals of        cmd : args -> do-          (_, stdout', _) <- liftIO $ readProcessWithExitCode cmd args ""+          existingEnv <- liftIO getEnvironment+          let mergedEnv = Map.toList $ Map.union envs $ Map.fromList existingEnv+          let process = (proc cmd args :: CreateProcess) { env = Just mergedEnv }+          (_, stdout', _) <- liftIO $ readCreateProcessWithExitCode process ""           pure . continue . encodeAbiValue $             AbiTuple (RegularVector.fromList [ AbiBytesDynamic . hexText . pack $ stdout'])        _ -> internalError (show vals)@@ -231,6 +233,10 @@            Nothing ->              internalError $ "oracle error: " ++ show q +    PleaseReadEnv variable continue -> do+      value <- liftIO $ lookupEnv variable+      pure . continue $ fromMaybe "" value+ type Fetcher t m s = App m => Query t s -> m (EVM t s ())  -- | Checks which branches are satisfiable, checking the pathconditions for consistency@@ -252,9 +258,7 @@         Unsat -> pure $ Case True         -- Yes. Both branches possible         Sat _ -> pure EVM.Types.Unknown-        -- Explore both branches in case of timeout-        EVM.Solvers.Unknown -> pure EVM.Types.Unknown-        Error e -> internalError $ "SMT Solver pureed with an error: " <> T.unpack e-    -- If the query times out, we simply explore both paths-    EVM.Solvers.Unknown -> pure EVM.Types.Unknown-    Error e -> internalError $ "SMT Solver pureed with an error: " <> T.unpack e+    -- If the query times out, or can't be executed (e.g. symbolic copyslice) we simply explore both paths+        _ -> pure EVM.Types.Unknown+    -- If the query times out, or can't be executed (e.g. symbolic copyslice) we simply explore both paths+    _ -> pure EVM.Types.Unknown

src/EVM/Format.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE ImplicitParams #-}  module EVM.Format@@ -35,12 +34,12 @@  import Prelude hiding (LT, GT) -import EVM.Types import EVM (traceForest, traceForest', traceContext, cheatCode) import EVM.ABI (getAbiSeq, parseTypeName, AbiValue(..), AbiType(..), SolError(..), Indexed(..), Event(..)) import EVM.Dapp (DappContext(..), DappInfo(..), findSrc, showTraceLocation) import EVM.Expr qualified as Expr import EVM.Solidity (SolcContract(..), Method(..), contractName, abiMap)+import EVM.Types  import Control.Arrow ((>>>)) import Optics.Core@@ -48,13 +47,14 @@ import Data.Bits (shiftR) import Data.ByteString (ByteString) import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as Char8+import Data.ByteString.Base16 qualified as BS16 import Data.ByteString.Builder (byteStringHex, toLazyByteString) import Data.ByteString.Lazy (toStrict, fromStrict) import Data.Char qualified as Char import Data.DoubleWord (signedWord) import Data.Foldable (toList) import Data.List (isPrefixOf, sort)-import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text, pack, unpack, intercalate, dropEnd, splitOn)@@ -64,8 +64,6 @@ import Data.Vector (Vector) import Hexdump (prettyHex) import Numeric (showHex)-import Data.ByteString.Char8 qualified as Char8-import Data.ByteString.Base16 qualified as BS16 import Witch (into, unsafeInto, tryFrom)  data Signedness = Signed | Unsigned@@ -109,13 +107,8 @@ showAbiValue :: (?context :: DappContext) => AbiValue -> Text showAbiValue (AbiString bs) = formatBytes bs showAbiValue (AbiBytesDynamic bs) = formatBytes bs-showAbiValue (AbiBytes _ bs) = formatBinary bs-showAbiValue (AbiAddress addr) =-  let name = case Map.lookup (LitAddr addr) ?context.env of-        Nothing -> ""-        Just contract -> maybeContractName' (findSrc contract ?context.info)-  in-    name <> "@" <> (pack $ show addr)+showAbiValue (AbiBytes _ bs) = formatBytes bs+showAbiValue (AbiAddress addr) = ppAddr (LitAddr addr) False showAbiValue v = pack $ show v  textAbiValues :: (?context :: DappContext) => Vector AbiValue -> [Text]@@ -151,7 +144,7 @@                   -- Method ID for Error(string)                   "\b\195y\160" -> showCall [AbiStringType] (ConcreteBuf bs)                   -- Method ID for Panic(uint256)-                  "NH{q"        -> "Panic" <> showCall [AbiUIntType 256] (ConcreteBuf bs)+                  "NH{q"        -> "Panic" <> parenthesise [formatBinary bs]                   _             -> formatBinary bs showError b = T.pack $ show b @@ -180,27 +173,34 @@   (<>) "0x" . T.decodeUtf8 . toStrict . toLazyByteString . byteStringHex  formatSBinary :: Expr Buf -> Text-formatSBinary (ConcreteBuf bs) = formatBinary bs-formatSBinary (AbstractBuf t) = "<" <> t <> " abstract buf>"-formatSBinary _ = internalError "formatSBinary: implement me"+formatSBinary e = format $ Expr.concKeccakSimpExpr e+  where+    format (ConcreteBuf bs) = formatBinary bs+    format (AbstractBuf t) = "<" <> t <> " abstract buf>"+    format e2 = T.pack $ "Symbolic expression: " <> show e2  showTraceTree :: DappInfo -> VM t s -> Text showTraceTree dapp vm =-  let forest = traceForest vm-      traces = fmap (fmap (unpack . showTrace dapp (vm.env.contracts))) forest+  let ?context = DappContext { info = dapp+                             , contracts = vm.env.contracts+                             , labels = vm.labels }+  in let forest = traceForest vm+         traces = fmap (fmap (unpack . showTrace)) forest   in pack $ concatMap showTree traces  showTraceTree' :: DappInfo -> Expr End -> Text showTraceTree' _ (ITE {}) = internalError "ITE does not contain a trace" showTraceTree' dapp leaf =-  let forest = traceForest' leaf-      traces = fmap (fmap (unpack . showTrace dapp (traceContext leaf))) forest+  let ?context = DappContext { info = dapp, contracts, labels }+  in let forest = traceForest' leaf+         traces = fmap (fmap (unpack . showTrace)) forest   in pack $ concatMap showTree traces+  where TraceContext { contracts, labels } = traceContext leaf -showTrace :: DappInfo -> Map (Expr EAddr) Contract -> Trace -> Text-showTrace dapp env trace =-  let ?context = DappContext { info = dapp, env = env }-  in let+showTrace :: (?context :: DappContext) => Trace -> Text+showTrace trace =+  let+    dapp = ?context.info     pos =       case showTraceLocation dapp trace of         Left x -> " \x1b[1m" <> x <> "\x1b[0m"@@ -253,10 +253,11 @@           ] <> pos          showEvent eventName argInfos indexedTopics = mconcat-          [ "\x1b[36m"+          [ "emit "+          , "\x1b[36m"           , eventName-          , parenthesise (snd <$> sort (unindexedArgs <> indexedArgs))           , "\x1b[0m"+          , parenthesise (snd <$> sort (unindexedArgs <> indexedArgs))           ] <> pos           where           -- We maintain the original position of event arguments since indexed@@ -321,48 +322,66 @@       t     FrameTrace (CreationContext { address }) ->       "create "-      <> maybeContractName (findSrcFromAddr address)-      <> "@" <> formatAddr address+      <> ppAddr address True       <> pos     FrameTrace (CallContext { target, context, abi, calldata }) ->       let calltype = if target == context                      then "call "                      else "delegatecall "-      in case findSrcFromAddr target of+      in+      calltype+      <> ppAddr target False+      <> "::"+      <> case findSrcFromAddr target of         Nothing ->-          calltype-            <> case target of-                 LitAddr 0x7109709ECfa91a80626fF3989D68f67F5b1DD12D -> "HEVM"-                 _ -> formatAddr target-            <> pack "::"-            <> case Map.lookup (unsafeInto (fromMaybe 0x00 abi)) dapp.abiMap of-                 Just m  ->-                   "\x1b[1m"-                   <> m.name-                   <> "\x1b[0m"-                   <> showCall (catMaybes (getAbiTypes m.methodSignature)) calldata-                 Nothing ->-                   formatSBinary calldata-            <> pos+          case Map.lookup (unsafeInto (fromMaybe 0x00 abi)) dapp.abiMap of+            Just m  ->+              "\x1b[1m"+              <> m.name+              <> "\x1b[0m"+              <> showCall (catMaybes (getAbiTypes m.methodSignature)) calldata+            Nothing ->+              formatSBinary calldata+          <> pos          Just solc ->-          calltype-            <> "\x1b[1m"-            <> contractNamePart solc.contractName-            <> "::"-            <> maybe "[fallback function]"+          maybe "[fallback function]"                  (fromMaybe "[unknown method]" . maybeAbiName solc)                  abi-            <> maybe ("(" <> formatSBinary calldata <> ")")-                 (\x -> showCall (catMaybes x) calldata)-                 (abi >>= fmap getAbiTypes . maybeAbiName solc)-            <> "\x1b[0m"-            <> pos+          <> maybe ("(" <> formatSBinary calldata <> ")")+                   (\x -> showCall (catMaybes x) calldata)+                   (abi >>= fmap getAbiTypes . maybeAbiName solc)+          <> pos     where     findSrcFromAddr addr = do-      contract <- Map.lookup addr env-      findSrc contract dapp+      contract <- Map.lookup addr ?context.contracts+      findSrc contract ?context.info +ppAddr :: (?context :: DappContext) => Expr EAddr -> Bool -> Text+ppAddr addr alwaysShowAddr =+  let+    sourceName = case Map.lookup addr ?context.contracts of+      Nothing ->+        case addr of+          LitAddr 0x7109709ECfa91a80626fF3989D68f67F5b1DD12D -> Just "HEVM"+          _ -> Nothing+      Just contract ->+        case (findSrc contract ?context.info) of+          Just x -> Just (contractNamePart x.contractName)+          Nothing -> Nothing+    label = case do litAddr <- maybeLitAddr addr+                    Map.lookup litAddr ?context.labels of+              Nothing -> ""+              Just l -> "[" <> "\x1b[1m" <> l <> "\x1b[0m" <> "]"+    name = maybe "" (\n -> "\x1b[1m" <> n <> "\x1b[0m") sourceName <> label+  in+    if name == "" then+      formatAddr addr+    else if alwaysShowAddr then+      name <> "@" <> formatAddr addr+    else+      name+ formatAddr :: Expr EAddr -> Text formatAddr = \case   LitAddr a -> pack (show a)@@ -376,14 +395,6 @@       filter (/= "") $         splitOn "," (dropEnd 1 (last (splitOn "(" abi))) -maybeContractName :: Maybe SolcContract -> Text-maybeContractName =-  maybe "<unknown contract>" (contractNamePart . (.contractName))--maybeContractName' :: Maybe SolcContract -> Text-maybeContractName' =-  maybe "" (contractNamePart . (.contractName))- maybeAbiName :: SolcContract -> W256 -> Maybe Text maybeAbiName solc abi = Map.lookup (unsafeInto abi) solc.abiMap <&> (.methodSignature) @@ -414,7 +425,7 @@   PrecompileFailure -> "Precompile failure"   ReturnDataOutOfBounds -> "Return data out of bounds"   NonceOverflow -> "Nonce overflow"-  BadCheatCode a -> "Bad cheat code: sig: " <> show a+  BadCheatCode reason a -> "Bad cheat code: " <>  reason <> " sig: " <> show a   NonexistentFork a -> "Fork ID does not exist: " <> show a  prettyvmresult :: Expr End -> String@@ -446,16 +457,17 @@  formatPartial :: PartialExec -> Text formatPartial = \case-  (UnexpectedSymbolicArg pc msg args) -> T.unlines+  (UnexpectedSymbolicArg pc opcode msg args) -> T.unlines     [ "Unexpected Symbolic Arguments to Opcode"     , indent 2 $ T.unlines       [ "msg: " <> T.pack (show msg)+      , "opcode: " <> T.pack opcode       , "program counter: " <> T.pack (show pc)       , "arguments: "       , indent 2 $ T.unlines . fmap formatSomeExpr $ args       ]     ]-  MaxIterationsReached pc addr -> "Max Iterations Reached in contract: " <> formatAddr addr <> " pc: " <> pack (show pc)+  MaxIterationsReached pc addr -> "Max Iterations Reached in contract: " <> formatAddr addr <> " pc: " <> pack (show pc) <> " To increase the maximum, set a fixed large (or negative) value for `--max-iterations` on the command line"   JumpIntoSymbolicCode pc idx -> "Encountered a jump into a potentially symbolic code region while executing initcode. pc: " <> pack (show pc) <> " jump dst: " <> pack (show idx)  formatSomeExpr :: SomeExpr -> Text@@ -654,13 +666,15 @@        BufLength b -> fmt "BufLength" [b] -      C code store bal nonce -> T.unlines+      C code store tStore bal nonce -> T.unlines         [ "(Contract"         , indent 2 $ T.unlines           [ "code:"           , indent 2 $ formatCode code           , "storage:"           , indent 2 $ formatExpr store+          , "tStorage:"+          , indent 2 $ formatExpr tStore           , "balance:"           , indent 2 $ formatExpr bal           , "nonce:"@@ -688,7 +702,7 @@           , "val:"           , indent 2 $ formatExpr val           , "store:"-          , indent 2 $ formatExpr prev          +          , indent 2 $ formatExpr prev           ]         , ")"         ]@@ -812,15 +826,15 @@ strip0x' :: String -> String strip0x' s = if "0x" `isPrefixOf` s then drop 2 s else s -hexByteString :: String -> ByteString -> ByteString-hexByteString msg bs =-  case BS16.decodeBase16 bs of-    Right x -> x-    _ -> internalError $ "invalid hex bytestring for " ++ msg+hexByteString :: ByteString -> Maybe ByteString+hexByteString bs =+  case BS16.decodeBase16Untyped bs of+    Right x -> pure x+    Left _ -> Nothing  hexText :: Text -> ByteString hexText t =-  case BS16.decodeBase16 (T.encodeUtf8 (T.drop 2 t)) of+  case BS16.decodeBase16Untyped (T.encodeUtf8 (T.drop 2 t)) of     Right x -> x     _ -> internalError $ "invalid hex bytestring " ++ show t

src/EVM/Fuzz.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-}- {- |     Module: EVM.Fuzz     Description: Concrete Fuzzer of Exprs@@ -7,21 +5,22 @@  module EVM.Fuzz where -import Prelude hiding (LT, GT, lookup)-import Control.Monad.State-import Data.Maybe (fromMaybe)+import Control.Monad (replicateM)+import Control.Monad.State (State, get, put, execState) import Data.Map.Strict as Map (fromList, Map, (!), (!?), insert)-import EVM.Expr qualified as Expr-import EVM.Expr (bytesToW256)+import Data.Maybe (fromMaybe) import Data.Set as Set (insert, Set, empty, toList, fromList)-import EVM.Traversals import Data.ByteString qualified as BS import Data.Word (Word8)-import Test.QuickCheck.Gen -import EVM.Types (Prop(..), W256, Expr(..), EType(..), internalError, keccak')+import EVM.Expr qualified as Expr+import EVM.Expr (bytesToW256) import EVM.SMT qualified as SMT (BufModel(..), SMTCex(..))+import EVM.Traversals+import EVM.Types (Prop(..), W256, Expr(..), EType(..), internalError, keccak')+ import Test.QuickCheck (Arbitrary(arbitrary))+import Test.QuickCheck.Gen import Test.QuickCheck.Random (mkQCGen)  -- TODO: Extract Var X = Lit Z, and set it

src/EVM/Keccak.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- {- |     Module: EVM.Keccak     Description: Expr passes to determine Keccak assumptions@@ -9,6 +7,7 @@ import Control.Monad.State import Data.Set (Set) import Data.Set qualified as Set+import Data.List (tails)  import EVM.Traversals import EVM.Types@@ -16,25 +15,22 @@   newtype KeccakStore = KeccakStore-  { keccakEqs :: Set (Expr EWord) }+  { keccakExprs :: Set (Expr EWord) }   deriving (Show)  initState :: KeccakStore-initState = KeccakStore { keccakEqs = Set.empty }+initState = KeccakStore { keccakExprs = Set.empty } -keccakFinder :: forall a. Expr a -> State KeccakStore (Expr a)+keccakFinder :: forall a. Expr a -> State KeccakStore () keccakFinder = \case-  e@(Keccak _) -> do-    s <- get-    put $ s{keccakEqs=Set.insert e s.keccakEqs}-    pure e-  e -> pure e+  e@(Keccak _) -> modify (\s -> s{keccakExprs=Set.insert e s.keccakExprs})+  _ -> pure () -findKeccakExpr :: forall a. Expr a -> State KeccakStore (Expr a)-findKeccakExpr e = mapExprM keccakFinder e+findKeccakExpr :: forall a. Expr a -> State KeccakStore ()+findKeccakExpr e = mapExprM_ keccakFinder e -findKeccakProp :: Prop -> State KeccakStore Prop-findKeccakProp p = mapPropM keccakFinder p+findKeccakProp :: Prop -> State KeccakStore ()+findKeccakProp p = mapPropM_ keccakFinder p  findKeccakPropsExprs :: [Prop] -> [Expr Buf]  -> [Expr Storage]-> State KeccakStore () findKeccakPropsExprs ps bufs stores = do@@ -43,25 +39,16 @@   mapM_ findKeccakExpr stores  -combine :: [a] -> [(a,a)]-combine lst = combine' lst []-  where-    combine' [] acc = concat acc-    combine' (x:xs) acc =-      let xcomb = [ (x, y) | y <- xs] in-      combine' xs (xcomb:acc)+uniquePairs :: [a] -> [(a,a)]+uniquePairs xs = [(x,y) | (x:ys) <- Data.List.tails xs, y <- ys]  minProp :: Expr EWord -> Prop minProp k@(Keccak _) = PGT k (Lit 256) minProp _ = internalError "expected keccak expression" -concVal :: Expr EWord -> Prop-concVal k@(Keccak (ConcreteBuf bs)) = PEq (Lit (keccak' bs)) k-concVal _ = PBool True- injProp :: (Expr EWord, Expr EWord) -> Prop injProp (k1@(Keccak b1), k2@(Keccak b2)) =-  POr ((b1 .== b2) .&& (bufLength b1 .== bufLength b2)) (PNeg (PEq k1 k2))+  PImpl (PEq k1 k2) ((b1 .== b2) .&& (bufLength b1 .== bufLength b2)) injProp _ = internalError "expected keccak expression"  @@ -73,17 +60,17 @@ --      here by making this claim for each unique pair of keccak invocations --      discovered in the input expressions) keccakAssumptions :: [Prop] -> [Expr Buf] -> [Expr Storage] -> [Prop]-keccakAssumptions ps bufs stores = injectivity <> minValue <> minDiffOfPairs <> concValues+keccakAssumptions ps bufs stores = injectivity <> minValue <> minDiffOfPairs   where     (_, st) = runState (findKeccakPropsExprs ps bufs stores) initState -    injectivity = fmap injProp $ combine (Set.toList st.keccakEqs)-    concValues = fmap concVal (Set.toList st.keccakEqs)-    minValue = fmap minProp (Set.toList st.keccakEqs)-    minDiffOfPairs = map minDistance $ filter (uncurry (/=)) [(a,b) | a<-(Set.elems st.keccakEqs), b<-(Set.elems st.keccakEqs)]+    keccakPairs = uniquePairs (Set.toList st.keccakExprs)+    injectivity = map injProp keccakPairs+    minValue = map minProp (Set.toList st.keccakExprs)+    minDiffOfPairs = map minDistance keccakPairs      where       minDistance :: (Expr EWord, Expr EWord) -> Prop-      minDistance (ka@(Keccak a), kb@(Keccak b)) = PImpl (a ./= b) (PAnd req1 req2)+      minDistance (ka@(Keccak a), kb@(Keccak b)) = PImpl ((a ./= b) .|| (bufLength a ./= bufLength b)) (PAnd req1 req2)         where           req1 = (PGEq (Sub ka kb) (Lit 256))           req2 = (PGEq (Sub kb ka) (Lit 256))@@ -94,7 +81,7 @@   e@(Keccak buf) -> do     let b = simplify buf     case keccak b of-      lit@(Lit _) -> [PEq e lit]+      lit@(Lit _) -> [PEq lit e]       _ -> []   _ -> []

src/EVM/Op.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- module EVM.Op   ( Op   , GenericOp (..)@@ -74,6 +72,8 @@     0x46 -> "CHAINID"     0x47 -> "SELFBALANCE"     0x48 -> "BASEFEE"+    0x49 -> "BLOBHASH"+    0x4A -> "BLOBBASEFEE"     0x50 -> "POP"     0x51 -> "MLOAD"     0x52 -> "MSTORE"@@ -86,7 +86,10 @@     0x59 -> "MSIZE"     0x5a -> "GAS"     0x5b -> "JUMPDEST"+    0x5c -> "TLOAD"+    0x5d -> "TSTORE"     --+    0x5e -> "MCOPY"     0x5f -> "PUSH0"     0x60 -> "PUSH1"     0x61 -> "PUSH2"@@ -171,7 +174,7 @@     0xfd -> "REVERT"     0xfe -> "INVALID"     0xff -> "SELFDESTRUCT"-    _ -> "UNKNOWN "+    _ -> "UNKNOWN (0x" <> showHex a "" <> ")"  opString :: (Integral a, Show a) => (a, Op) -> String opString (i, o) = let showPc x | x < 0x10 = '0' : showHex x ""@@ -229,12 +232,17 @@   OpChainid -> "CHAINID"   OpSelfbalance -> "SELFBALANCE"   OpBaseFee -> "BASEFEE"+  OpBlobhash -> "BLOBHASH"+  OpBlobBaseFee -> "BLOBBASEFEE"   OpPop -> "POP"+  OpMcopy -> "MCOPY"   OpMload -> "MLOAD"   OpMstore -> "MSTORE"   OpMstore8 -> "MSTORE8"   OpSload -> "SLOAD"   OpSstore -> "SSTORE"+  OpTload -> "TLOAD"+  OpTstore -> "TSTORE"   OpJump -> "JUMP"   OpJumpi -> "JUMPI"   OpPc -> "PC"@@ -323,6 +331,8 @@   0x46 -> OpChainid   0x47 -> OpSelfbalance   0x48 -> OpBaseFee+  0x49 -> OpBlobhash+  0x4A -> OpBlobBaseFee   0x50 -> OpPop   0x51 -> OpMload   0x52 -> OpMstore@@ -335,6 +345,9 @@   0x59 -> OpMsize   0x5a -> OpGas   0x5b -> OpJumpdest+  0x5c -> OpTload+  0x5d -> OpTstore+  0x5e -> OpMcopy   0x5f -> OpPush0   0xf0 -> OpCreate   0xf1 -> OpCall

src/EVM/Precompiled.hs view

@@ -12,11 +12,11 @@ -- | Opaque representation of the C library's context struct. data EthjetContext -foreign import ccall "ethjet_init"+foreign import ccall unsafe "ethjet_init"   ethjet_init :: IO (Ptr EthjetContext)-foreign import ccall "&ethjet_free"+foreign import ccall unsafe "&ethjet_free"   ethjet_free :: FunPtr (Ptr EthjetContext -> IO ())-foreign import ccall "ethjet"+foreign import ccall unsafe "ethjet"   ethjet     :: Ptr EthjetContext     -- initialized context     -> CInt                  -- operation

src/EVM/SMT.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-}  {- |@@ -17,7 +16,8 @@ import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty qualified as NonEmpty import Data.String.Here-import Data.Maybe (fromJust, fromMaybe)+import Data.Maybe (fromJust, fromMaybe, isJust)+import Data.Either.Extra (fromRight') import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set (Set)@@ -31,7 +31,6 @@ import Language.SMT2.Syntax (Symbol, SpecConstant(..), GeneralRes(..), Term(..), QualIdentifier(..), Identifier(..), Sort(..), Index(..), VarBinding(..)) import Numeric (readHex, readBin) import Witch (into, unsafeInto)-import Control.Monad.State (State, runState, get, put) import EVM.Format (formatProp)  import EVM.CSE@@ -103,16 +102,25 @@   }   deriving (Eq, Show) ---- | Used for abstraction-refinement of the SMT formula. Contains assertions that make our query fully precise. These will be added to the assertion stack if we get `sat` with the abstracted query.-data RefinementEqs = RefinementEqs [Builder] [Prop]-  deriving (Eq, Show)--instance Semigroup RefinementEqs where-  (RefinementEqs a b) <> (RefinementEqs a2 b2) = RefinementEqs (a <> a2) (b <> b2)+instance Semigroup SMTCex where+  a <> b = SMTCex+    { vars = a.vars <> b.vars+    , addrs = a.addrs <> b.addrs+    , buffers = a.buffers <> b.buffers+    , store = a.store <> b.store+    , blockContext = a.blockContext <> b.blockContext+    , txContext = a.txContext <> b.txContext+    } -instance Monoid RefinementEqs where-  mempty = RefinementEqs mempty mempty+instance Monoid SMTCex where+  mempty = SMTCex+    { vars = mempty+    , addrs = mempty+    , buffers = mempty+    , store = mempty+    , blockContext = mempty+    , txContext = mempty+    }  flattenBufs :: SMTCex -> Maybe SMTCex flattenBufs cex = do@@ -133,38 +141,42 @@ getVar :: SMTCex -> TS.Text -> W256 getVar cex name = fromJust $ Map.lookup (Var name) cex.vars -data SMT2 = SMT2 [Builder] RefinementEqs CexVars [Prop]+data SMT2 = SMT2 [Builder] CexVars [Prop]   deriving (Eq, Show)  instance Semigroup SMT2 where-  (SMT2 a (RefinementEqs b refps) c d) <> (SMT2 a2 (RefinementEqs b2 refps2) c2 d2) = SMT2 (a <> a2) (RefinementEqs (b <> b2) (refps <> refps2)) (c <> c2) (d <> d2)+  (SMT2 a c d) <> (SMT2 a2 c2 d2) = SMT2 (a <> a2) (c <> c2) (d <> d2)  instance Monoid SMT2 where-  mempty = SMT2 mempty mempty mempty mempty+  mempty = SMT2 mempty mempty mempty  formatSMT2 :: SMT2 -> Text-formatSMT2 (SMT2 ls _ _ ps) = expr <> smt2+formatSMT2 (SMT2 ls _ ps) = expr <> smt2  where  expr = T.concat [T.singleton ';', T.replace "\n" "\n;" $ T.pack . TS.unpack $  TS.unlines (fmap formatProp ps)]  smt2 = T.unlines (fmap toLazyText ls)  -- | Reads all intermediate variables from the builder state and produces SMT declaring them as constants-declareIntermediates :: BufEnv -> StoreEnv -> SMT2-declareIntermediates bufs stores =+declareIntermediates :: BufEnv -> StoreEnv -> Err SMT2+declareIntermediates bufs stores = do   let encSs = Map.mapWithKey encodeStore stores       encBs = Map.mapWithKey encodeBuf bufs       sorted = List.sortBy compareFst $ Map.toList $ encSs <> encBs-      decls = fmap snd sorted-      smt2 = (SMT2 [fromText "; intermediate buffers & stores"] mempty mempty mempty):decls-  in  foldr (<>) (SMT2[""] mempty mempty mempty) smt2+  decls <- mapM snd sorted+  let smt2 = (SMT2 [fromText "; intermediate buffers & stores"] mempty mempty):decls+  pure $ foldr (<>) mempty smt2   where     compareFst (l, _) (r, _) = compare l r-    encodeBuf n expr =-      SMT2 ["(define-fun buf" <> (fromString . show $ n) <> "() Buf " <> exprToSMT expr <> ")\n"]  mempty mempty mempty <> encodeBufLen n expr-    encodeBufLen n expr =-      SMT2 ["(define-fun buf" <> (fromString . show $ n) <>"_length () (_ BitVec 256) " <> exprToSMT (bufLengthEnv bufs True expr) <> ")"] mempty mempty mempty-    encodeStore n expr =-      SMT2 ["(define-fun store" <> (fromString . show $ n) <> " () Storage " <> exprToSMT expr <> ")"] mempty mempty mempty+    encodeBuf n expr = do+      buf <- exprToSMT expr+      bufLen <- encodeBufLen n expr+      pure $ SMT2 ["(define-fun buf" <> (fromString . show $ n) <> "() Buf " <> buf <> ")\n"]  mempty mempty <> bufLen+    encodeBufLen n expr = do+      bufLen <- exprToSMT (bufLengthEnv bufs True expr)+      pure $ SMT2 ["(define-fun buf" <> (fromString . show $ n) <>"_length () (_ BitVec 256) " <> bufLen <> ")"] mempty mempty+    encodeStore n expr = do+      storage <- exprToSMT expr+      pure $ SMT2 ["(define-fun store" <> (fromString . show $ n) <> " () Storage " <> storage <> ")"] mempty mempty  data AbstState = AbstState   { words :: Map (Expr EWord) Int@@ -172,55 +184,37 @@   }   deriving (Show) -abstractAwayProps :: Config -> [Prop] -> ([Prop], AbstState)-abstractAwayProps conf ps = runState (mapM abstrAway ps) (AbstState mempty 0)-  where-    abstrAway :: Prop -> State AbstState Prop-    abstrAway prop = mapPropM go prop-    go :: Expr a -> State AbstState (Expr a)-    go x = case x of-        e@(Mod{})       | conf.abstRefineArith  -> abstrExpr e-        e@(SMod{})      | conf.abstRefineArith  -> abstrExpr e-        e@(MulMod{})    | conf.abstRefineArith  -> abstrExpr e-        e@(AddMod{})    | conf.abstRefineArith  -> abstrExpr e-        e@(Mul{})       | conf.abstRefineArith  -> abstrExpr e-        e@(Div{})       | conf.abstRefineArith  -> abstrExpr e-        e@(SDiv {})     | conf.abstRefineArith  -> abstrExpr e-        e@(ReadWord {}) | conf.abstRefineMem -> abstrExpr e-        e -> pure e-        where-            abstrExpr e = do-              s <- get-              case Map.lookup e s.words of-                Just v -> pure (Var (TS.pack ("abst_" ++ show v)))-                Nothing -> do-                  let-                    next = s.count-                    bs' = Map.insert e next s.words-                  put $ s{words=bs', count=next+1}-                  pure $ Var (TS.pack ("abst_" ++ show next))- smt2Line :: Builder -> SMT2-smt2Line txt = SMT2 [txt] mempty mempty mempty+smt2Line txt = SMT2 [txt] mempty mempty -assertProps :: Config -> [Prop] -> SMT2+assertProps :: Config -> [Prop] -> Err SMT2 -- simplify to rewrite sload/sstore combos -- notice: it is VERY important not to concretize, because Keccak assumptions --         will be generated by assertPropsNoSimp, and that needs unconcretized Props-assertProps conf ps = assertPropsNoSimp conf (decompose . Expr.simplifyProps $ ps)+assertProps conf ps = assertPropsNoSimp (decompose . Expr.simplifyProps $ ps)   where     decompose :: [Prop] -> [Prop]-    decompose props = fromMaybe props (mapM (mapPropM Expr.decomposeStorage) props)+    decompose props = if conf.decomposeStorage && safeExprs && safeProps+                      then fromMaybe props (mapM (mapPropM Expr.decomposeStorage) props)+                      else props+      where+        -- All in these lists must be a `Just ()` or we cannot decompose+        safeExprs = all (isJust . mapPropM_ Expr.safeToDecompose) props+        safeProps = all Expr.safeToDecomposeProp props  -- Note: we need a version that does NOT call simplify, -- because we make use of it to verify the correctness of our simplification -- passes through property-based testing.-assertPropsNoSimp :: Config -> [Prop] -> SMT2-assertPropsNoSimp config psPreConc =-  let encs = map propToSMT psElimAbst-      abstSMT = map propToSMT abstProps-      intermediates = declareIntermediates bufs stores in-  prelude+assertPropsNoSimp :: [Prop] -> Err SMT2+assertPropsNoSimp psPreConc = do+ encs <- mapM propToSMT psElim+ smt <- mapM propToSMT props+ intermediates <- declareIntermediates bufs stores+ readAssumes' <- readAssumes+ keccakAssertions' <- keccakAssertions+ frameCtxs <- (declareFrameContext . nubOrd $ foldl (<>) [] frameCtx)+ blockCtxs <- (declareBlockContext . nubOrd $ foldl (<>) [] blockCtx)+ pure $ prelude   <> (declareAbstractStores abstractStores)   <> smt2Line ""   <> (declareAddrs addresses)@@ -229,28 +223,26 @@   <> smt2Line ""   <> (declareVars . nubOrd $ foldl (<>) [] allVars)   <> smt2Line ""-  <> (declareFrameContext . nubOrd $ foldl (<>) [] frameCtx)+  <> frameCtxs   <> smt2Line ""-  <> (declareBlockContext . nubOrd $ foldl (<>) [] blockCtx)+  <> blockCtxs   <> smt2Line ""   <> intermediates   <> smt2Line ""-  <> keccakAssertions-  <> readAssumes+  <> keccakAssertions'+  <> readAssumes'   <> smt2Line ""-  <> SMT2 (fmap (\p -> "(assert " <> p <> ")") encs) mempty mempty mempty-  <> SMT2 mempty (RefinementEqs (fmap (\p -> "(assert " <> p <> ")") abstSMT) (psElimAbst <> abstProps)) mempty mempty-  <> SMT2 mempty mempty mempty { storeReads = storageReads } mempty-  <> SMT2 mempty mempty mempty psPreConc+  <> SMT2 (fmap (\p -> "(assert " <> p <> ")") encs) mempty mempty+  <> SMT2 smt mempty mempty+  <> SMT2 mempty mempty { storeReads = storageReads } mempty+  <> SMT2 mempty mempty psPreConc    where     ps = Expr.concKeccakProps psPreConc     (psElim, bufs, stores) = eliminateProps ps-    (psElimAbst, abst@(AbstState abstExprToInt _)) = if config.abstRefineArith || config.abstRefineMem-      then abstractAwayProps config psElim-      else (psElim, AbstState mempty 0)+    abst@(AbstState exprToInt _) = AbstState mempty 0 -    abstProps = map toProp (Map.toList abstExprToInt)+    props = map toProp (Map.toList exprToInt)       where       toProp :: (Expr EWord, Int) -> Prop       toProp (e, num) = PEq e (Var (TS.pack ("abst_" ++ (show num))))@@ -278,16 +270,18 @@     --      This will make sure concrete values of Keccak are asserted, if they can be computed (i.e. can be concretized)     keccAssump = keccakAssumptions psPreConc bufVals storeVals     keccComp = keccakCompute psPreConc bufVals storeVals-    keccakAssertions-      = smt2Line "; keccak assumptions"-      <> SMT2 (fmap (\p -> "(assert " <> propToSMT p <> ")") keccAssump) mempty mempty mempty-      <> smt2Line "; keccak computations"-      <> SMT2 (fmap (\p -> "(assert " <> propToSMT p <> ")") keccComp) mempty mempty mempty+    keccakAssertions = do+      assumps <- mapM assertSMT keccAssump+      comps <- mapM assertSMT keccComp+      pure $ smt2Line "; keccak assumptions"+        <> SMT2 assumps mempty mempty+        <> smt2Line "; keccak computations"+        <> SMT2 comps mempty mempty      -- assert that reads beyond size of buffer & storage is zero-    readAssumes-      = smt2Line "; read assumptions"-        <> SMT2 (fmap (\p -> "(assert " <> propToSMT p <> ")") (assertReads psElim bufs stores)) mempty mempty mempty+    readAssumes = do+      assumps <- mapM assertSMT $ assertReads psElim bufs stores+      pure $ smt2Line "; read assumptions" <> SMT2 assumps mempty mempty  referencedAbstractStores :: TraversableTerm a => a -> Set Builder referencedAbstractStores term = foldTerm go mempty term@@ -379,12 +373,9 @@ assertReads props benv senv = concatMap assertRead allReads   where     assertRead :: (Expr EWord, Expr EWord, Expr Buf) -> [Prop]+    assertRead (_, Lit 0, _) = []     assertRead (idx, Lit 32, buf) = [PImpl (PGEq idx (bufLength buf)) (PEq (ReadWord idx buf) (Lit 0))]-    assertRead (idx, Lit sz, buf) =-      fmap-        -- TODO: unsafeInto instead fromIntegral here makes symbolic tests fail-        (PImpl (PGEq idx (bufLength buf)) . PEq (ReadByte idx buf) . LitByte . fromIntegral)-        [(0::Int)..unsafeInto sz-1]+    assertRead (idx, Lit sz, buf) = [PImpl (PGEq (Expr.add idx $ Lit offset) (bufLength buf)) (PEq (ReadByte (Expr.add idx $ Lit offset) buf) (LitByte 0)) | offset <- [(0::W256).. sz-1]]     assertRead (_, _, _) = internalError "Cannot generate assertions for accesses of symbolic size"      allReads = filter keepRead $ nubOrd $ findBufferAccess props <> findBufferAccess (Map.elems benv) <> findBufferAccess (Map.elems senv)@@ -425,54 +416,70 @@  -- | Returns an SMT2 object with all buffers referenced from the input props declared, and with the appropriate cex extraction metadata attached declareBufs :: [Prop] -> BufEnv -> StoreEnv -> SMT2-declareBufs props bufEnv storeEnv = SMT2 ("; buffers" : fmap declareBuf allBufs <> ("; buffer lengths" : fmap declareLength allBufs)) mempty cexvars mempty+declareBufs props bufEnv storeEnv = SMT2 ("; buffers" : fmap declareBuf allBufs <> ("; buffer lengths" : fmap declareLength allBufs)) cexvars mempty   where     cexvars = (mempty :: CexVars){ buffers = discoverMaxReads props bufEnv storeEnv }     allBufs = fmap fromLazyText $ Map.keys cexvars.buffers-    declareBuf n = "(declare-const " <> n <> " (Array (_ BitVec 256) (_ BitVec 8)))"-    declareLength n = "(declare-const " <> n <> "_length" <> " (_ BitVec 256))"+    declareBuf n = "(declare-fun " <> n <> " () (Array (_ BitVec 256) (_ BitVec 8)))"+    declareLength n = "(declare-fun " <> n <> "_length" <> " () (_ BitVec 256))"  -- Given a list of variable names, create an SMT2 object with the variables declared declareVars :: [Builder] -> SMT2-declareVars names = SMT2 (["; variables"] <> fmap declare names) mempty cexvars mempty+declareVars names = SMT2 (["; variables"] <> fmap declare names) cexvars mempty   where-    declare n = "(declare-const " <> n <> " (_ BitVec 256))"+    declare n = "(declare-fun " <> n <> " () (_ BitVec 256))"     cexvars = (mempty :: CexVars){ calldata = fmap toLazyText names }  -- Given a list of variable names, create an SMT2 object with the variables declared declareAddrs :: [Builder] -> SMT2-declareAddrs names = SMT2 (["; symbolic addresseses"] <> fmap declare names) mempty cexvars mempty+declareAddrs names = SMT2 (["; symbolic addresseses"] <> fmap declare names) cexvars mempty   where-    declare n = "(declare-const " <> n <> " Addr)"+    declare n = "(declare-fun " <> n <> " () Addr)"     cexvars = (mempty :: CexVars){ addrs = fmap toLazyText names } -declareFrameContext :: [(Builder, [Prop])] -> SMT2-declareFrameContext names = SMT2 (["; frame context"] <> concatMap declare names) mempty cexvars mempty+declareFrameContext :: [(Builder, [Prop])] -> Err SMT2+declareFrameContext names = do+  decls <- concatMapM declare names+  pure $ SMT2 (["; frame context"] <> decls) cexvars mempty   where-    declare (n,props) = [ "(declare-const " <> n <> " (_ BitVec 256))" ]-                        <> fmap (\p -> "(assert " <> propToSMT p <> ")") props+    declare (n,props) = do+      asserts <- mapM assertSMT props+      pure $ [ "(declare-fun " <> n <> " () (_ BitVec 256))" ] <> asserts     cexvars = (mempty :: CexVars){ txContext = fmap (toLazyText . fst) names }  declareAbstractStores :: [Builder] -> SMT2-declareAbstractStores names = SMT2 (["; abstract base stores"] <> fmap declare names) mempty mempty mempty+declareAbstractStores names = SMT2 (["; abstract base stores"] <> fmap declare names) mempty mempty   where-    declare n = "(declare-const " <> n <> " Storage)"+    declare n = "(declare-fun " <> n <> " () Storage)" -declareBlockContext :: [(Builder, [Prop])] -> SMT2-declareBlockContext names = SMT2 (["; block context"] <> concatMap declare names) mempty cexvars mempty+declareBlockContext :: [(Builder, [Prop])] -> Err SMT2+declareBlockContext names = do+  decls <- concatMapM declare names+  pure $ SMT2 (["; block context"] <> decls) cexvars mempty   where-    declare (n, props) = [ "(declare-const " <> n <> " (_ BitVec 256))" ]-                         <> fmap (\p -> "(assert " <> propToSMT p <> ")") props+    declare (n, props) = do+      asserts <- mapM assertSMT props+      pure $ [ "(declare-fun " <> n <> " () (_ BitVec 256))" ] <> asserts     cexvars = (mempty :: CexVars){ blockContext = fmap (toLazyText . fst) names } +assertSMT :: Prop -> Either String Builder+assertSMT p = do+  p' <- propToSMT p+  pure $ "(assert " <> p' <> ")"+ prelude :: SMT2-prelude =  SMT2 src mempty mempty mempty+prelude =  SMT2 src mempty mempty   where   src = fmap (fromLazyText . T.drop 2) . T.lines $ [i|   ; logic-  ; TODO: this creates an error when used with z3?+  (set-info :smt-lib-version 2.6)   ;(set-logic QF_AUFBV)   (set-logic ALL)+  (set-info :source |+  Generator: hevm+  Application: hevm symbolic execution system+  |)+  (set-info :category "industrial")    ; types   (define-sort Byte () (_ BitVec 8))@@ -483,9 +490,11 @@   ; slot -> value   (define-sort Storage () (Array Word Word)) -  ; hash functions-  (declare-fun keccak (Buf) Word)-  (declare-fun sha256 (Buf) Word)+  ; hash functions. They take buffer and a buffer size, and return a Word+  (declare-fun keccak (Buf Word) Word)+  (declare-fun sha256 (Buf Word) Word)++  ; helper functions   (define-fun max ((a (_ BitVec 256)) (b (_ BitVec 256))) (_ BitVec 256) (ite (bvult a b) b a))    ; word indexing@@ -564,37 +573,38 @@   (define-fun readWord ((idx Word) (buf Buf)) Word     (concat       (select buf idx)-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000001))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000002))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000003))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000004))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000005))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000006))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000007))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000008))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000009))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000a))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000b))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000c))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000d))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000e))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000f))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000010))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000011))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000012))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000013))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000014))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000015))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000016))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000017))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000018))-      (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000019))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001a))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001b))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001c))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001d))-      (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001e))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000001))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000002))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000003))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000004))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000005))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000006))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000007))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000008))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000009))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000a))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000b))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000c))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000d))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000e))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000000f))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000010))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000011))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000012))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000013))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000014))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000015))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000016))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000017))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000018))+      (concat (select buf (bvadd idx #x0000000000000000000000000000000000000000000000000000000000000019))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001a))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001b))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001c))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001d))+      (concat (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001e))       (select buf (bvadd idx #x000000000000000000000000000000000000000000000000000000000000001f))+      ))))))))))))))))))))))))))))))     )   ) @@ -674,12 +684,12 @@     (ite (= b (_ bv30 256)) ((_ sign_extend 8  ) ((_ extract 247  0) val)) val))))))))))))))))))))))))))))))))   |] -exprToSMT :: Expr a -> Builder+exprToSMT :: Expr a -> Err Builder exprToSMT = \case-  Lit w -> fromLazyText $ "(_ bv" <> (T.pack $ show (into w :: Integer)) <> " 256)"-  Var s -> fromText s-  GVar (BufVar n) -> fromString $ "buf" <> (show n)-  GVar (StoreVar n) -> fromString $ "store" <> (show n)+  Lit w -> pure $ fromLazyText $ "(_ bv" <> (T.pack $ show (into w :: Integer)) <> " 256)"+  Var s -> pure $ fromText s+  GVar (BufVar n) -> pure $ fromString $ "buf" <> (show n)+  GVar (StoreVar n) -> pure $ fromString $ "store" <> (show n)   JoinBytes     z o two three four five six seven     eight nine ten eleven twelve thirteen fourteen fifteen@@ -696,39 +706,39 @@   Mul a b -> op2 "bvmul" a b   Exp a b -> case b of                Lit b' -> expandExp a b'-               _ -> internalError "cannot encode symbolic exponentiation into SMT"-  Min a b ->-    let aenc = exprToSMT a-        benc = exprToSMT b in-    "(ite (bvule " <> aenc `sp` benc <> ") " <> aenc `sp` benc <> ")"-  Max a b ->-    let aenc = exprToSMT a-        benc = exprToSMT b in-    "(max " <> aenc `sp` benc <> ")"-  LT a b ->-    let cond = op2 "bvult" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  SLT a b ->-    let cond = op2 "bvslt" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  SGT a b ->-    let cond = op2 "bvsgt" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  GT a b ->-    let cond = op2 "bvugt" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  LEq a b ->-    let cond = op2 "bvule" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  GEq a b ->-    let cond = op2 "bvuge" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  Eq a b ->-    let cond = op2 "=" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  IsZero a ->-    let cond = op2 "=" a (Lit 0) in-    "(ite " <> cond `sp` one `sp` zero <> ")"+               _ -> Left "cannot encode symbolic exponentiation into SMT"+  Min a b -> do+    aenc <- exprToSMT a+    benc <- exprToSMT b+    pure $ "(ite (bvule " <> aenc `sp` benc <> ") " <> aenc `sp` benc <> ")"+  Max a b -> do+    aenc <- exprToSMT a+    benc <- exprToSMT b+    pure $ "(max " <> aenc `sp` benc <> ")"+  LT a b -> do+    cond <- op2 "bvult" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  SLT a b -> do+    cond <- op2 "bvslt" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  SGT a b -> do+    cond <- op2 "bvsgt" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  GT a b -> do+    cond <- op2 "bvugt" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  LEq a b -> do+    cond <- op2 "bvule" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  GEq a b -> do+    cond <- op2 "bvuge" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  Eq a b -> do+    cond <- op2 "=" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  IsZero a -> do+    cond <- op2 "=" a (Lit 0)+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"   And a b -> op2 "bvand" a b   Or a b -> op2 "bvor" a b   Xor a b -> op2 "bvxor" a b@@ -742,106 +752,112 @@   Mod a b -> op2CheckZero "bvurem" a b   SMod a b -> op2CheckZero "bvsrem" a b   -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast-  MulMod a b c ->-    let aExp = exprToSMT a-        bExp = exprToSMT b-        cExp = exprToSMT c-        aLift = "(concat (_ bv0 256) " <> aExp <> ")"+  MulMod a b c -> do+    aExp <- exprToSMT a+    bExp <- exprToSMT b+    cExp <- exprToSMT c+    let aLift = "(concat (_ bv0 256) " <> aExp <> ")"         bLift = "(concat (_ bv0 256) " <> bExp <> ")"         cLift = "(concat (_ bv0 256) " <> cExp <> ")"-    in  "((_ extract 255 0) (ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 512) (bvurem (bvmul " <> aLift `sp` bLift <> ")" <> cLift <> ")))"-  AddMod a b c ->-    let aExp = exprToSMT a-        bExp = exprToSMT b-        cExp = exprToSMT c-        aLift = "(concat (_ bv0 256) " <> aExp <> ")"+    pure $ "((_ extract 255 0) (ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 512) (bvurem (bvmul " <> aLift `sp` bLift <> ")" <> cLift <> ")))"+  AddMod a b c -> do+    aExp <- exprToSMT a+    bExp <- exprToSMT b+    cExp <- exprToSMT c+    let aLift = "(concat (_ bv0 256) " <> aExp <> ")"         bLift = "(concat (_ bv0 256) " <> bExp <> ")"         cLift = "(concat (_ bv0 256) " <> cExp <> ")"-    in  "((_ extract 255 0) (ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 512) (bvurem (bvadd " <> aLift `sp` bLift <> ")" <> cLift <> ")))"-  EqByte a b ->-    let cond = op2 "=" a b in-    "(ite " <> cond `sp` one `sp` zero <> ")"-  Keccak a ->-    let enc = exprToSMT a in-    "(keccak " <> enc <> ")"-  SHA256 a ->-    let enc = exprToSMT a in-    "(sha256 " <> enc <> ")"+    pure $ "((_ extract 255 0) (ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 512) (bvurem (bvadd " <> aLift `sp` bLift <> ")" <> cLift <> ")))"+  EqByte a b -> do+    cond <- op2 "=" a b+    pure $ "(ite " <> cond `sp` one `sp` zero <> ")"+  Keccak a -> do+    enc <- exprToSMT a+    sz  <- exprToSMT $ Expr.bufLength a+    pure $ "(keccak " <> enc <> " " <> sz <> ")"+  SHA256 a -> do+    enc <- exprToSMT a+    sz  <- exprToSMT $ Expr.bufLength a+    pure $ "(sha256 " <> enc <> " " <> sz <> ")" -  TxValue -> fromString "txvalue"-  Balance a -> fromString "balance_" <> formatEAddr a+  TxValue -> pure $ fromString "txvalue"+  Balance a -> pure $ fromString "balance_" <> formatEAddr a -  Origin ->  "origin"-  BlockHash a ->-    let enc = exprToSMT a in-    "(blockhash " <> enc <> ")"-  CodeSize a ->-    let enc = exprToSMT a in-    "(codesize " <> enc <> ")"-  Coinbase -> "coinbase"-  Timestamp -> "timestamp"-  BlockNumber -> "blocknumber"-  PrevRandao -> "prevrandao"-  GasLimit -> "gaslimit"-  ChainId -> "chainid"-  BaseFee -> "basefee"+  Origin ->  pure "origin"+  BlockHash a -> do+    enc <- exprToSMT a+    pure $ "(blockhash " <> enc <> ")"+  CodeSize a -> do+    enc <- exprToSMT a+    pure $ "(codesize " <> enc <> ")"+  Coinbase -> pure "coinbase"+  Timestamp -> pure "timestamp"+  BlockNumber -> pure "blocknumber"+  PrevRandao -> pure "prevrandao"+  GasLimit -> pure "gaslimit"+  ChainId -> pure "chainid"+  BaseFee -> pure "basefee" -  a@(SymAddr _) -> formatEAddr a-  WAddr(a@(SymAddr _)) -> "(concat (_ bv0 96)" `sp` exprToSMT a `sp` ")"+  a@(SymAddr _) -> pure $ formatEAddr a+  WAddr(a@(SymAddr _)) -> do+    wa <- exprToSMT a+    pure $ "((_ zero_extend 96)" `sp` wa `sp` ")" -  LitByte b -> fromLazyText $ "(_ bv" <> T.pack (show (into b :: Integer)) <> " 8)"+  LitByte b -> pure $ fromLazyText $ "(_ bv" <> T.pack (show (into b :: Integer)) <> " 8)"   IndexWord idx w -> case idx of     Lit n -> if n >= 0 && n < 32-             then-               let enc = exprToSMT w in-               fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` enc <> ")"+             then do+               enc <- exprToSMT w+               pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` enc <> ")"              else exprToSMT (LitByte 0)     _ -> op2 "indexWord" idx w   ReadByte idx src -> op2 "select" src idx -  ConcreteBuf "" -> "((as const Buf) #b00000000)"+  ConcreteBuf "" -> pure "((as const Buf) #b00000000)"   ConcreteBuf bs -> writeBytes bs mempty-  AbstractBuf s -> fromText s+  AbstractBuf s -> pure $ fromText s   ReadWord idx prev -> op2 "readWord" idx prev-  BufLength (AbstractBuf b) -> fromText b <> "_length"-  BufLength (GVar (BufVar n)) -> fromLazyText $ "buf" <> (T.pack . show $ n) <> "_length"+  BufLength (AbstractBuf b) -> pure $ fromText b <> "_length"+  BufLength (GVar (BufVar n)) -> pure $ fromLazyText $ "buf" <> (T.pack . show $ n) <> "_length"   BufLength b -> exprToSMT (bufLength b)-  WriteByte idx val prev ->-    let encIdx = exprToSMT idx-        encVal = exprToSMT val-        encPrev = exprToSMT prev in-    "(store " <> encPrev `sp` encIdx `sp` encVal <> ")"-  WriteWord idx val prev ->-    let encIdx = exprToSMT idx-        encVal = exprToSMT val-        encPrev = exprToSMT prev in-    "(writeWord " <> encIdx `sp` encVal `sp` encPrev <> ")"-  CopySlice srcIdx dstIdx size src dst ->-    copySlice srcIdx dstIdx size (exprToSMT src) (exprToSMT dst)+  WriteByte idx val prev -> do+    encIdx  <- exprToSMT idx+    encVal  <- exprToSMT val+    encPrev <- exprToSMT prev+    pure $ "(store " <> encPrev `sp` encIdx `sp` encVal <> ")"+  WriteWord idx val prev -> do+    encIdx  <- exprToSMT idx+    encVal  <- exprToSMT val+    encPrev <- exprToSMT prev+    pure $ "(writeWord " <> encIdx `sp` encVal `sp` encPrev <> ")"+  CopySlice srcIdx dstIdx size src dst -> do+    srcSMT <- exprToSMT src+    dstSMT <- exprToSMT dst+    copySlice srcIdx dstIdx size srcSMT dstSMT    -- we need to do a bit of processing here.   ConcreteStore s -> encodeConcreteStore s-  AbstractStore a idx -> storeName a idx-  SStore idx val prev ->-    let encIdx = exprToSMT idx-        encVal = exprToSMT val-        encPrev = exprToSMT prev in-    "(store" `sp` encPrev `sp` encIdx `sp` encVal <> ")"+  AbstractStore a idx -> pure $ storeName a idx+  SStore idx val prev -> do+    encIdx  <- exprToSMT idx+    encVal  <- exprToSMT val+    encPrev <- exprToSMT prev+    pure $ "(store" `sp` encPrev `sp` encIdx `sp` encVal <> ")"   SLoad idx store -> op2 "select" store idx    a -> internalError $ "TODO: implement: " <> show a   where-    op1 op a =-      let enc =  exprToSMT a in-      "(" <> op `sp` enc <> ")"-    op2 op a b =-      let aenc = exprToSMT a-          benc = exprToSMT b in-      "(" <> op `sp` aenc `sp` benc <> ")"-    op2CheckZero op a b =-      let aenc = exprToSMT a-          benc = exprToSMT b in-      "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <>  "(" <> op `sp` aenc `sp` benc <> "))"+    op1 op a = do+      enc <- exprToSMT a+      pure $ "(" <> op `sp` enc <> ")"+    op2 op a b = do+       aenc <- exprToSMT a+       benc <- exprToSMT b+       pure $ "(" <> op `sp` aenc `sp` benc <> ")"+    op2CheckZero op a b = do+      aenc <- exprToSMT a+      benc <- exprToSMT b+      pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <>  "(" <> op `sp` aenc `sp` benc <> "))"  sp :: Builder -> Builder -> Builder a `sp` b = a <> (fromText " ") <> b@@ -852,34 +868,34 @@ one :: Builder one = "(_ bv1 256)" -propToSMT :: Prop -> Builder+propToSMT :: Prop -> Err Builder propToSMT = \case   PEq a b -> op2 "=" a b   PLT a b -> op2 "bvult" a b   PGT a b -> op2 "bvugt" a b   PLEq a b -> op2 "bvule" a b   PGEq a b -> op2 "bvuge" a b-  PNeg a ->-    let enc = propToSMT a in-    "(not " <> enc <> ")"-  PAnd a b ->-    let aenc = propToSMT a-        benc = propToSMT b in-    "(and " <> aenc <> " " <> benc <> ")"-  POr a b ->-    let aenc = propToSMT a-        benc = propToSMT b in-    "(or " <> aenc <> " " <> benc <> ")"-  PImpl a b ->-    let aenc = propToSMT a-        benc = propToSMT b in-    "(=> " <> aenc <> " " <> benc <> ")"-  PBool b -> if b then "true" else "false"+  PNeg a -> do+    enc <- propToSMT a+    pure $ "(not " <> enc <> ")"+  PAnd a b -> do+    aenc <- propToSMT a+    benc <- propToSMT b+    pure $ "(and " <> aenc <> " " <> benc <> ")"+  POr a b -> do+    aenc <- propToSMT a+    benc <- propToSMT b+    pure $ "(or " <> aenc <> " " <> benc <> ")"+  PImpl a b -> do+    aenc <- propToSMT a+    benc <- propToSMT b+    pure $ "(=> " <> aenc <> " " <> benc <> ")"+  PBool b -> pure $ if b then "true" else "false"   where-    op2 op a b =-      let aenc = exprToSMT a-          benc = exprToSMT b in-      "(" <> op <> " " <> aenc <> " " <> benc <> ")"+    op2 op a b = do+      aenc <- exprToSMT a+      benc <- exprToSMT b+      pure $ "(" <> op <> " " <> aenc <> " " <> benc <> ")"   @@ -887,59 +903,67 @@   -- | Stores a region of src into dst-copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Builder-copySlice srcOffset dstOffset size@(Lit _) src dst-  | size == (Lit 0) = dst-  | otherwise =-    let size' = (Expr.sub size (Lit 1))-        encDstOff = exprToSMT (Expr.add dstOffset size')-        encSrcOff = exprToSMT (Expr.add srcOffset size')-        child = copySlice srcOffset dstOffset size' src dst in-    "(store " <> child `sp` encDstOff `sp` "(select " <> src `sp` encSrcOff <> "))"-copySlice _ _ _ _ _ = internalError "TODO: implement copySlice with a symbolically sized region"+copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder+copySlice srcOffset dstOffset size0@(Lit _) src dst = do+  sz <- internal size0+  pure $ "(let ((src " <> src <> ")) " <> sz <> ")"+  where+    internal (Lit 0) = pure dst+    internal size = do+      let size' = (Expr.sub size (Lit 1))+      encDstOff <- exprToSMT (Expr.add dstOffset size')+      encSrcOff <- exprToSMT (Expr.add srcOffset size')+      child <- internal size'+      pure $ "(store " <> child `sp` encDstOff `sp` "(select src " <> encSrcOff <> "))"+copySlice _ _ _ _ _ = Left "CopySlice with a symbolically sized region not currently implemented, cannot execute SMT solver on this query"  -- | Unrolls an exponentiation into a series of multiplications-expandExp :: Expr EWord -> W256 -> Builder+expandExp :: Expr EWord -> W256 -> Err Builder expandExp base expnt   | expnt == 1 = exprToSMT base-  | otherwise =-    let b = exprToSMT base-        n = expandExp base (expnt - 1) in-    "(bvmul " <> b `sp` n <> ")"+  | otherwise = do+    b <- exprToSMT base+    n <- expandExp base (expnt - 1)+    pure $ "(bvmul " <> b `sp` n <> ")"  -- | Concatenates a list of bytes into a larger bitvector-concatBytes :: [Expr Byte] -> Builder-concatBytes bytes =+concatBytes :: [Expr Byte] -> Err Builder+concatBytes bytes = do   let bytesRev = reverse bytes-      a2 = exprToSMT (head bytesRev) in-  foldl wrap a2 $ tail bytesRev+  a2 <- exprToSMT (head bytesRev)+  foldM wrap a2 $ tail bytesRev   where-    wrap inner byte =-      let byteSMT = exprToSMT byte in-      "(concat " <> byteSMT `sp` inner <> ")"+    wrap :: Builder -> Expr a -> Err Builder+    wrap inner byte = do+      byteSMT <- exprToSMT byte+      pure $ "(concat " <> byteSMT `sp` inner <> ")"  -- | Concatenates a list of bytes into a larger bitvector-writeBytes :: ByteString -> Expr Buf -> Builder-writeBytes bytes buf = snd $ BS.foldl' wrap (0, exprToSMT buf) bytes+writeBytes :: ByteString -> Expr Buf -> Err Builder+writeBytes bytes buf =  do+  buf' <- exprToSMT buf+  ret <- foldM wrap (0, buf') $ BS.unpack bytes+  pure $ snd ret   where     -- we don't need to store zeros if the base buffer is empty     skipZeros = buf == mempty-    wrap :: (Int, Builder) -> Word8 -> (Int, Builder)+    wrap :: (Int, Builder) -> Word8 -> Err (Int, Builder)     wrap (idx, inner) byte =       if skipZeros && byte == 0-      then (idx + 1, inner)-      else let-          byteSMT = exprToSMT (LitByte byte)-          idxSMT = exprToSMT . Lit . unsafeInto $ idx-        in (idx + 1, "(store " <> inner `sp` idxSMT `sp` byteSMT <> ")")+      then pure (idx + 1, inner)+      else do+          byteSMT <- exprToSMT (LitByte byte)+          idxSMT <- exprToSMT . Lit . unsafeInto $ idx+          pure (idx + 1, "(store " <> inner `sp` idxSMT `sp` byteSMT <> ")") -encodeConcreteStore :: Map W256 W256 -> Builder-encodeConcreteStore s = foldl encodeWrite "((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000)" (Map.toList s)+encodeConcreteStore :: Map W256 W256 -> Err Builder+encodeConcreteStore s = foldM encodeWrite ("((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000)") (Map.toList s)   where-    encodeWrite prev (key, val) = let-        encKey = exprToSMT (Lit key)-        encVal = exprToSMT (Lit val)-      in "(store " <> prev `sp` encKey `sp` encVal <> ")"+    encodeWrite :: Builder -> (W256, W256) -> Err Builder+    encodeWrite prev (key, val) = do+      encKey <- exprToSMT $ Lit key+      encVal <- exprToSMT $ Lit val+      pure $ "(store " <> prev `sp` encKey `sp` encVal <> ")"  storeName :: Expr EAddr -> Maybe W256 -> Builder storeName a Nothing = fromString ("baseStore_") <> formatEAddr a@@ -1130,7 +1154,8 @@ queryValue :: (Text -> IO Text) -> Expr EWord -> IO W256 queryValue _ (Lit w) = pure w queryValue getVal w = do-  let expr = toLazyText $ exprToSMT w+  -- this exprToSMT should never fail, since we have already ran the solver+  let expr = toLazyText $ fromRight' $ exprToSMT w   raw <- getVal expr   case parseCommentFreeFileMsg getValueRes (T.toStrict raw) of     Right (ResSpecific (valParsed :| [])) ->

src/EVM/Solidity.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} @@ -45,6 +44,7 @@  import Optics.Core import Optics.Operators.Unsafe+import EVM.Effects;  import Control.Applicative import Control.Monad@@ -73,6 +73,7 @@ import Data.Text (pack, intercalate) import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import Data.Text.IO (writeFile) import Data.Vector (Vector) import Data.Vector qualified as Vector import Data.Word (Word8)@@ -184,7 +185,7 @@   mempty = BuildOutput mempty mempty  -- | The various project types understood by hevm-data ProjectType = DappTools | CombinedJSON | Foundry | FoundryStdLib+data ProjectType = CombinedJSON | Foundry   deriving (Eq, Show, Read, ParseField)  data SourceCache = SourceCache@@ -283,24 +284,17 @@     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 root DappTools = do-  let outDir = root </> "out"-  jsons <- 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 :: App m => FilePath -> ProjectType -> m (Either String BuildOutput) 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@@ -308,9 +302,14 @@       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 +341,19 @@     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-  let fileContents = fmap Data.Text.Encoding.decodeUtf8 (Data.ByteString.readFile fp)-  (readJSON pt (T.pack $ takeBaseName fp) <$> fileContents) >>=-    \case-      Nothing -> pure . Left $ "unable to parse: " <> 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 <> " 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)@@ -380,13 +381,16 @@   pure $ Map.lookup ("hevm.sol:" <> contract) sol <&> (.creationCode)  solcRuntime-  :: (MonadUnliftIO m)+  :: App m   => Text -> Text -> m (Maybe ByteString)-solcRuntime contract src = liftIO $ do-  json <- solc Solidity src-  case readStdJSON json of-    Just (Contracts sol, _, _) -> pure $ Map.lookup ("hevm.sol:" <> contract) sol <&> (.runtimeCode)-    Nothing -> internalError $ "unable to parse solidity output:\n" <> (T.unpack json)+solcRuntime contract src = do+  conf <- readConfig+  liftIO $ do+    json <- solc Solidity src+    when conf.dumpExprs $ liftIO $ Data.Text.IO.writeFile "compiled_code.json" json+    case readStdJSON json of+      Just (Contracts sol, _, _) -> pure $ Map.lookup ("hevm.sol:" <> contract) sol <&> (.runtimeCode)+      Nothing -> internalError $ "unable to parse solidity output:\n" <> (T.unpack json)  functionAbi :: Text -> IO Method functionAbi f = do@@ -394,15 +398,14 @@   let (Contracts sol, _, _) = fromMaybe                                 (internalError . T.unpack $ "unable to parse solc output:\n" <> json)                                 (readStdJSON json)-  case Map.toList $ (fromJust (Map.lookup "hevm.sol:ABI" sol)).abiMap of-     [(_,b)] -> pure b-     _ -> internalError "unexpected abi format"+  case Map.toList (fromJust (Map.lookup "hevm.sol:ABI" sol)).abiMap of+    [(_,b)] -> pure b+    _ -> internalError "unexpected abi format"  force :: String -> Maybe a -> a force s = fromMaybe (internalError s)  readJSON :: ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)-readJSON DappTools _ json = readStdJSON json readJSON CombinedJSON _ json = readCombinedJSON json readJSON _ contractName json = readFoundryJSON contractName json @@ -658,18 +661,14 @@ containsLinkerHole = regexMatches "__\\$[a-z0-9]{34}\\$__"  toCode :: Text -> Text -> ByteString-toCode contractName t = case BS16.decodeBase16 (encodeUtf8 t) of+toCode contractName t = case BS16.decodeBase16Untyped (encodeUtf8 t) of   Right d -> d   Left e -> if containsLinkerHole t             then error $ T.unpack ("Error toCode: unlinked libraries detected in bytecode, in " <> contractName)             else error $ T.unpack ("Error toCode:" <> e <> ", in " <> contractName)  solc :: Language -> Text -> IO Text-solc lang src =-  T.pack <$> readProcess-    "solc"-    ["--standard-json"]-    (T.unpack $ stdjson lang src)+solc lang src = T.pack <$> readProcess "solc" ["--standard-json"] (T.unpack $ stdjson lang src)  data Language = Solidity | Yul   deriving (Show)@@ -680,8 +679,7 @@ instance ToJSON StandardJSON where   toJSON (StandardJSON lang src) =     object [ "language" .= show lang-           , "sources" .= object ["hevm.sol" .=-                                   object ["content" .= src]]+           , "sources" .= object ["hevm.sol" .= object ["content" .= src]]            , "settings" .=              object [ "outputSelection" .=                     object ["*" .=

src/EVM/Solvers.hs view

@@ -17,7 +17,7 @@ import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (fromMaybe, isJust, fromJust)-import Data.Text qualified as TS+import Data.Either (isLeft) import Data.Text.Lazy (Text) import Data.Text.Lazy qualified as T import Data.Text.Lazy.IO qualified as T@@ -28,7 +28,7 @@ import EVM.Fuzz (tryCexFuzz)  import EVM.SMT-import EVM.Types (W256, Expr(AbstractBuf), internalError)+import EVM.Types (W256, Expr(AbstractBuf), internalError, Err, getError, getNonError)  -- | Supported solvers data Solver@@ -65,41 +65,38 @@ data CheckSatResult   = Sat SMTCex   | Unsat-  | Unknown-  | Error TS.Text+  | Unknown String+  | Error String   deriving (Show, Eq)  isSat :: CheckSatResult -> Bool isSat (Sat _) = True isSat _ = False -isErr :: CheckSatResult -> Bool-isErr (Error _) = True-isErr _ = False- isUnsat :: CheckSatResult -> Bool isUnsat Unsat = True isUnsat _ = False -checkSat :: SolverGroup -> SMT2 -> IO CheckSatResult+checkSat :: SolverGroup -> Err SMT2 -> IO CheckSatResult checkSat (SolverGroup taskQueue) script = do-  -- prepare result channel-  resChan <- newChan-  -- send task to solver group-  writeChan taskQueue (Task script resChan)-  -- collect result-  readChan resChan+  if isLeft script then pure $ Error $ getError script+  else do+    -- prepare result channel+    resChan <- newChan+    -- send task to solver group+    writeChan taskQueue (Task (getNonError script) resChan)+    -- collect result+    readChan resChan -writeSMT2File :: SMT2 -> Int -> String -> IO ()-writeSMT2File smt2 count abst =-  do+writeSMT2File :: SMT2 -> Int -> IO ()+writeSMT2File smt2 count =     let content = formatSMT2 smt2 <> "\n\n(check-sat)"-    T.writeFile ("query-" <> (show count) <> "-" <> abst <> ".smt2") content+    in T.writeFile ("query-" <> (show count) <> ".smt2") content -withSolvers :: App m => Solver -> Natural -> Maybe Natural -> (SolverGroup -> m a) -> m a-withSolvers solver count timeout cont = do+withSolvers :: App m => Solver -> Natural -> Natural -> Maybe Natural -> (SolverGroup -> m a) -> m a+withSolvers solver count threads timeout cont = do     -- spawn solvers-    instances <- mapM (const $ liftIO $ spawnSolver solver timeout) [1..count]+    instances <- mapM (const $ liftIO $ spawnSolver solver threads timeout) [1..count]     -- spawn orchestration thread     taskQueue <- liftIO newChan     availableInstances <- liftIO newChan@@ -124,47 +121,36 @@       orchestrate queue avail (fileCounter + 1)      runTask :: (MonadIO m, ReadConfig m) => Task -> SolverInstance -> Chan SolverInstance -> Int -> m ()-    runTask (Task smt2@(SMT2 cmds (RefinementEqs refineEqs refps) cexvars ps) r) inst availableInstances fileCounter = do+    runTask (Task smt2@(SMT2 cmds cexvars ps) r) inst availableInstances fileCounter = do       conf <- readConfig       let fuzzResult = tryCexFuzz ps conf.numCexFuzz       liftIO $ do-        when (conf.dumpQueries) $ writeSMT2File smt2 fileCounter "abstracted"+        when (conf.dumpQueries) $ writeSMT2File smt2 fileCounter         if (isJust fuzzResult)           then do-            when (conf.debug) $ putStrLn $ "Cex found via fuzzing:" <> (show fuzzResult)+            when (conf.debug) $ putStrLn $ "   Cex found via fuzzing:" <> (show fuzzResult)             writeChan r (Sat $ fromJust fuzzResult)           else if not conf.onlyCexFuzz then do-            when (conf.debug) $ putStrLn "Fuzzing failed to find a Cex"+            when (conf.debug) $ putStrLn "   Fuzzing failed to find a Cex"             -- reset solver and send all lines of provided script-            out <- sendScript inst (SMT2 ("(reset)" : cmds) mempty mempty ps)+            out <- sendScript inst (SMT2 ("(reset)" : cmds) mempty ps)             case out of               -- if we got an error then return it-              Left e -> writeChan r (Error ("error while writing SMT to solver: " <> T.toStrict e))+              Left e -> writeChan r (Error $ "Error while writing SMT to solver: " <> T.unpack e)               -- otherwise call (check-sat), parse the result, and send it down the result channel               Right () -> do                 sat <- sendLine inst "(check-sat)"                 res <- do                     case sat of                       "unsat" -> pure Unsat-                      "timeout" -> pure Unknown-                      "unknown" -> pure Unknown-                      "sat" -> if null refineEqs then Sat <$> getModel inst cexvars-                               else do-                                    let refinedSMT2 = SMT2 refineEqs mempty mempty (ps <> refps)-                                    writeSMT2File refinedSMT2 fileCounter "refined"-                                    _ <- sendScript inst refinedSMT2-                                    sat2 <- sendLine inst "(check-sat)"-                                    case sat2 of-                                      "unsat" -> pure Unsat-                                      "timeout" -> pure Unknown-                                      "unknown" -> pure Unknown-                                      "sat" -> Sat <$> getModel inst cexvars-                                      _ -> pure . Error $ T.toStrict $ "Unable to parse solver output: " <> sat2-                      _ -> pure . Error $ T.toStrict $ "Unable to parse solver output: " <> sat+                      "timeout" -> pure $ Unknown "Result timeout by SMT solver"+                      "unknown" -> pure $ Unknown "Result unknown by SMT solver"+                      "sat" -> Sat <$> getModel inst cexvars+                      _ -> pure . Error $ "Unable to parse SMT solver output: " <> T.unpack sat                 writeChan r res           else do             when (conf.debug) $ putStrLn "Fuzzing failed to find a Cex, not trying SMT due to onlyCexFuzz"-            writeChan r Unknown+            writeChan r $ Error "Option onlyCexFuzz enabled, not running SMT"          -- put the instance back in the list of available instances         writeChan availableInstances inst@@ -254,8 +240,8 @@   Just t' -> t'  -- | Arguments used when spawning a solver instance-solverArgs :: Solver -> Maybe Natural -> [Text]-solverArgs solver timeout = case solver of+solverArgs :: Solver -> Natural -> Maybe Natural -> [Text]+solverArgs solver threads timeout = case solver of   Bitwuzla ->     [ "--lang=smt2"     , "--produce-models"@@ -263,7 +249,9 @@     , "--bv-solver=preprop"     ]   Z3 ->-    [ "-in" ]+    [ "-st"+    , "smt.threads=" <> (T.pack $ show threads)+    , "-in" ]   CVC5 ->     [ "--lang=smt"     , "--produce-models"@@ -275,11 +263,11 @@   Custom _ -> []  -- | Spawns a solver instance, and sets the various global config options that we use for our queries-spawnSolver :: Solver -> Maybe (Natural) -> IO SolverInstance-spawnSolver solver timeout = do+spawnSolver :: Solver -> Natural -> Maybe (Natural) -> IO SolverInstance+spawnSolver solver threads timeout = do   (readout, writeout) <- createPipe   let cmd-        = (proc (show solver) (fmap T.unpack $ solverArgs solver timeout))+        = (proc (show solver) (fmap T.unpack $ solverArgs solver threads timeout ))             { std_in = CreatePipe             , std_out = UseHandle writeout             , std_err = UseHandle writeout@@ -305,7 +293,7 @@  -- | Sends a list of commands to the solver. Returns the first error, if there was one. sendScript :: SolverInstance -> SMT2 -> IO (Either Text ())-sendScript solver (SMT2 cmds _ _ _) = do+sendScript solver (SMT2 cmds _ _) = do   let sexprs = splitSExpr $ fmap toLazyText cmds   go sexprs   where@@ -333,23 +321,27 @@     ';' : _ -> pure "success" -- ignore comments     _ -> sendLine inst cmd' +-- | Strips trailing \r, if present+stripCarriageReturn :: Text -> Text+stripCarriageReturn t = fromMaybe t $ T.stripSuffix "\r" t+ -- | Sends a string to the solver and appends a newline, returns the first available line from the output buffer sendLine :: SolverInstance -> Text -> IO Text sendLine (SolverInstance _ stdin stdout _) cmd = do-  T.hPutStr stdin (T.append cmd "\n")+  T.hPutStrLn stdin cmd   hFlush stdin-  T.hGetLine stdout+  stripCarriageReturn <$> (T.hGetLine stdout)  -- | Sends a string to the solver and appends a newline, doesn't return stdout sendLine' :: SolverInstance -> Text -> IO () sendLine' (SolverInstance _ stdin _ _) cmd = do-  T.hPutStr stdin (T.append cmd "\n")+  T.hPutStrLn stdin cmd   hFlush stdin  -- | Returns a string representation of the model for the requested variable getValue :: SolverInstance -> Text -> IO Text getValue (SolverInstance _ stdin stdout _) var = do-  T.hPutStr stdin (T.append (T.append "(get-value (" var) "))\n")+  T.hPutStrLn stdin (T.append (T.append "(get-value (" var) "))")   hFlush stdin   fmap (T.unlines . reverse) (readSExpr stdout) @@ -359,18 +351,20 @@   where     go 0 0 _ = do       line <- T.hGetLine h-      let ls = T.length $ T.filter (== '(') line-          rs = T.length $ T.filter (== ')') line+      let cleanLine = stripCarriageReturn line+          ls = T.length $ T.filter (== '(') cleanLine+          rs = T.length $ T.filter (== ')') cleanLine       if ls == rs-         then pure [line]-         else go ls rs [line]+         then pure [cleanLine]+         else go ls rs [cleanLine]     go ls rs prev = do       line <- T.hGetLine h-      let ls' = T.length $ T.filter (== '(') line-          rs' = T.length $ T.filter (== ')') line+      let cleanLine = stripCarriageReturn line+          ls' = T.length $ T.filter (== '(') cleanLine+          rs' = T.length $ T.filter (== ')') cleanLine       if (ls + ls') == (rs + rs')-         then pure $ line : prev-         else go (ls + ls') (rs + rs') (line : prev)+         then pure $ cleanLine : prev+         else go (ls + ls') (rs + rs') (cleanLine : prev)  -- From a list of lines, take each separate SExpression and put it in -- its own list, after removing comments.@@ -393,8 +387,8 @@ getSExpr l = go LPar l 0 []   where     go _ text 0 prev@(_:_) = (T.intercalate "" (reverse prev), text)-    go _ _ r _ | r < 0 = internalError "Unbalanced SExpression"-    go _ "" _ _  = internalError "Unbalanced SExpression"+    go _ _ r _ | r < 0 = internalError $ "Unbalanced SExpression: " <> show l+    go _ "" _ _  = internalError $ "Unbalanced SExpression: " <> show l     -- find the next left parenthesis     go LPar line r prev = -- r is how many right parentheses we are missing       let (before, after) = T.breakOn "(" line in

src/EVM/Stepper.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}  module EVM.Stepper@@ -23,17 +22,17 @@ -- The implementation uses the operational monad pattern -- as the framework for monadic interpretation. +import Control.Monad.IO.Class import Control.Monad.Operational (Program, ProgramViewT(..), ProgramView, singleton, view)+import Control.Monad.ST (stToIO, RealWorld) import Control.Monad.State.Strict (execStateT, runStateT, get) import Data.Text (Text)  import EVM qualified+import EVM.Effects import EVM.Exec qualified import EVM.Fetch qualified as Fetch import EVM.Types-import Control.Monad.ST (stToIO, RealWorld)-import Control.Monad.IO.Class-import EVM.Effects  -- | The instruction type of the operational monad data Action t s a where

src/EVM/SymExec.hs view

@@ -1,21 +1,21 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE ScopedTypeVariables #-}  module EVM.SymExec where  import Control.Concurrent.Async (concurrently, mapConcurrently) import Control.Concurrent.Spawn (parMapIO, pool) import Control.Concurrent.STM (atomically, TVar, readTVarIO, readTVar, newTVarIO, writeTVar)+import Control.Monad (when, forM_, forM)+import Control.Monad.IO.Unlift import Control.Monad.Operational qualified as Operational import Control.Monad.ST (RealWorld, stToIO, ST)-import Control.Monad.State.Strict-import Data.Bifunctor (second)+import Control.Monad.State.Strict (runStateT)+import Data.Bifunctor (second, first) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Containers.ListUtils (nubOrd) import Data.DoubleWord (Word256)-import Data.List (foldl', sortBy)+import Data.List (foldl', sortBy, sort, group) import Data.Maybe (fromMaybe, mapMaybe) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map@@ -27,12 +27,16 @@ import Data.Text.IO qualified as T import Data.Tree.Zipper qualified as Zipper import Data.Tuple (swap)+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VUnboxed import EVM (makeVm, abstractContract, initialContract, getCodeLocation, isValidJumpDest) import EVM.Exec import EVM.Fetch qualified as Fetch import EVM.ABI+import EVM.Effects import EVM.Expr qualified as Expr-import EVM.Format (formatExpr, formatPartial, showVal, bsToHex)+import EVM.FeeSchedule (feeSchedule)+import EVM.Format (formatExpr, formatPartial, showVal, bsToHex, indent, formatBinary) import EVM.SMT (SMTCex(..), SMT2(..), assertProps) import EVM.SMT qualified as SMT import EVM.Solvers@@ -40,38 +44,49 @@ import EVM.Stepper qualified as Stepper import EVM.Traversals import EVM.Types-import EVM.FeeSchedule (feeSchedule)-import EVM.Format (indent, formatBinary) import GHC.Conc (getNumProcessors) import GHC.Generics (Generic) import Optics.Core import Options.Generic (ParseField, ParseFields, ParseRecord)+import Text.Printf (printf) import Witch (into, unsafeInto)-import EVM.Effects-import Control.Monad.IO.Unlift  data LoopHeuristic   = Naive   | StackBased   deriving (Eq, Show, Read, ParseField, ParseFields, ParseRecord, Generic) -data ProofResult a b c = Qed a | Cex b | Timeout c+data ProofResult a b c d = Qed a | Cex b | Unknown c | Error d   deriving (Show, Eq)-type VerifyResult = ProofResult () (Expr End, SMTCex) (Expr End)-type EquivResult = ProofResult () (SMTCex) ()+type VerifyResult = ProofResult () (Expr End, SMTCex) (Expr End) String+type EquivResult = ProofResult () (SMTCex) () String -isTimeout :: ProofResult a b c -> Bool-isTimeout (Timeout _) = True-isTimeout _ = False+isUnknown :: ProofResult a b c d -> Bool+isUnknown (EVM.SymExec.Unknown _) = True+isUnknown _ = False -isCex :: ProofResult a b c -> Bool+isError :: ProofResult a b c d -> Bool+isError (EVM.SymExec.Error _) = True+isError _ = False++isCex :: ProofResult a b c d -> Bool isCex (Cex _) = True isCex _ = False -isQed :: ProofResult a b c -> Bool+isQed :: ProofResult a b c d -> Bool isQed (Qed _) = True isQed _ = False +groupIssues :: [ProofResult a b c String] -> [(Integer, String)]+groupIssues results = map (\g -> (into (length g), head g)) grouped+  where+    getErr :: ProofResult a b c String -> String+    getErr (EVM.SymExec.Error k) = k+    getErr (EVM.SymExec.Unknown _) = "SMT result timeout/unknown"+    getErr _ = internalError "shouldn't happen"+    sorted = sort $ map getErr results+    grouped = group sorted+ data VeriOpts = VeriOpts   { simp :: Bool   , maxIter :: Maybe Integer@@ -98,29 +113,33 @@ extractCex _ = Nothing  bool :: Expr EWord -> Prop-bool e = POr (PEq e (Lit 1)) (PEq e (Lit 0))+bool e = POr (PEq (Lit 1) e) (PEq (Lit 0) e)  -- | Abstract calldata argument generation symAbiArg :: Text -> AbiType -> CalldataFragment symAbiArg name = \case   AbiUIntType n ->     if n `mod` 8 == 0 && n <= 256-    then let v = Var name in St [Expr.inRange n v] v+    then St [Expr.inRange n v] v     else internalError "bad type"   AbiIntType n ->     if n `mod` 8 == 0 && n <= 256     -- TODO: is this correct?-    then let v = Var name in St [Expr.inRange n v] v+    then St [Expr.inRange n v] v     else internalError "bad type"-  AbiBoolType -> let v = Var name in St [bool v] v+  AbiBoolType -> St [bool v] v   AbiAddressType -> St [] (WAddr (SymAddr name))   AbiBytesType n ->     if n > 0 && n <= 32-    then let v = Var name in St [Expr.inRange (n * 8) v] v+    then St [Expr.inRange (n * 8) v] v     else internalError "bad type"-  AbiArrayType sz tp ->-    Comp $ fmap (\n -> symAbiArg (name <> n) tp) [T.pack (show n) | n <- [0..sz-1]]+  AbiArrayType sz tps -> do+    Comp . V.toList . V.imap (\(T.pack . show -> i) tp -> symAbiArg (name <> "-a-" <> i) tp) $ (V.replicate sz tps)+  AbiTupleType tps ->+    Comp . V.toList . V.imap (\(T.pack . show -> i) tp -> symAbiArg (name <> "-t-" <> i) tp) $ tps   t -> internalError $ "TODO: symbolic abi encoding for " <> show t+  where+    v = Var name  data CalldataFragment   = St [Prop] (Expr EWord)@@ -186,6 +205,7 @@  isSt :: CalldataFragment -> Bool isSt (St {}) = True+isSt (Comp fs) = all isSt fs isSt _ = False  @@ -236,8 +256,29 @@     , create = create     , txAccessList = mempty     , allowFFI = False+    , freshAddresses = 0+    , beaconRoot = 0     }) +-- freezes any mutable refs, making it safe to share between threads+freezeVM :: VM Symbolic RealWorld -> ST RealWorld (VM Symbolic RealWorld)+freezeVM vm = do+    state' <- do+      mem' <- freeze (vm.state.memory)+      pure $ vm.state { memory = mem' }+    frames' <- forM (vm.frames :: [Frame Symbolic RealWorld]) $ \frame -> do+      mem' <- freeze frame.state.memory+      pure $ (frame :: Frame Symbolic RealWorld) { state = frame.state { memory = mem' } }++    pure (vm :: VM Symbolic RealWorld)+      { state = state'+      , frames = frames'+      }+  where+    freeze = \case+      ConcreteMemory m -> SymbolicMemory . ConcreteBuf . BS.pack . VUnboxed.toList <$> VUnboxed.freeze m+      m@(SymbolicMemory _) -> pure m+ -- | Interpreter which explores all paths at branching points. Returns an -- 'Expr End' representing the possible executions. interpret@@ -267,11 +308,12 @@         r <- liftIO q         interpret fetcher maxIter askSmtIters heuristic vm (k r)       Stepper.Ask (PleaseChoosePath cond continue) -> do+        frozen <- liftIO $ stToIO $ freezeVM vm         evalLeft <- toIO $ do-          (ra, vma) <- liftIO $ stToIO $ runStateT (continue True) vm { result = Nothing }+          (ra, vma) <- liftIO $ stToIO $ runStateT (continue True) frozen { result = Nothing }           interpret fetcher maxIter askSmtIters heuristic vma (k ra)         evalRight <- toIO $ do-          (rb, vmb) <- liftIO $ stToIO $ runStateT (continue False) vm { result = Nothing }+          (rb, vmb) <- liftIO $ stToIO $ runStateT (continue False) frozen { result = Nothing }           interpret fetcher maxIter askSmtIters heuristic vmb (k rb)         (a, b) <- liftIO $ concurrently evalLeft evalRight         pure $ ITE cond a b@@ -293,7 +335,7 @@                 case (maxIterationsReached vm maxIter, isLoopHead heuristic vm) of                   -- Yes. return a partial leaf                   (Just _, Just True) ->-                    pure $ Partial [] (Traces (Zipper.toForest vm.traces) vm.env.contracts) $ MaxIterationsReached vm.state.pc vm.state.contract+                    pure $ Partial [] (TraceContext (Zipper.toForest vm.traces) vm.env.contracts vm.labels) $ MaxIterationsReached vm.state.pc vm.state.contract                   -- No. keep executing                   _ -> do                     (r, vm') <- liftIO $ stToIO $ runStateT (continue (Case (c > 0))) vm@@ -309,7 +351,7 @@                     -- got us to this point and return a partial leaf for the other side                     (r, vm') <- liftIO $ stToIO $ runStateT (continue (Case $ not n)) vm                     a <- interpret fetcher maxIter askSmtIters heuristic vm' (k r)-                    pure $ ITE cond a (Partial [] (Traces (Zipper.toForest vm.traces) vm.env.contracts) (MaxIterationsReached vm.state.pc vm.state.contract))+                    pure $ ITE cond a (Partial [] (TraceContext (Zipper.toForest vm.traces) vm.env.contracts vm.labels) (MaxIterationsReached vm.state.pc vm.state.contract))                   -- we're in a loop and askSmtIters has been reached                   (Just True, True, _) ->                     -- ask the smt solver about the loop condition@@ -457,7 +499,7 @@ runExpr :: Stepper.Stepper Symbolic RealWorld (Expr End) runExpr = do   vm <- Stepper.runFully-  let traces = Traces (Zipper.toForest vm.traces) vm.env.contracts+  let traces = TraceContext (Zipper.toForest vm.traces) vm.env.contracts vm.labels   pure $ case vm.result of     Just (VMSuccess buf) -> Success vm.constraints traces buf (fmap toEContract vm.env.contracts)     Just (VMFailure e) -> Failure vm.constraints traces e@@ -465,7 +507,7 @@     _ -> internalError "vm in intermediate state after call to runFully"  toEContract :: Contract -> Expr EContract-toEContract c = C c.code c.storage c.balance c.nonce+toEContract c = C c.code c.storage c.tStorage c.balance c.nonce  -- | Converts a given top level expr into a list of final states and the -- associated path conditions for each state.@@ -474,7 +516,7 @@   where     go :: [Prop] -> Expr End -> [Expr End]     go pcs = \case-      ITE c t f -> go (PNeg ((PEq c (Lit 0))) : pcs) t <> go (PEq c (Lit 0) : pcs) f+      ITE c t f -> go (PNeg ((PEq (Lit 0) c)) : pcs) t <> go (PEq (Lit 0) c : pcs) f       Success ps trace msg store -> [Success (nubOrd $ ps <> pcs) trace msg store]       Failure ps trace e -> [Failure (nubOrd $ ps <> pcs) trace e]       Partial ps trace p -> [Partial (nubOrd $ ps <> pcs) trace p]@@ -517,8 +559,8 @@         let query = assertProps conf pcs         res <- checkSat solvers query         case res of-          Sat _ -> pure ([query], Just leaf)-          Unsat -> pure ([query], Nothing)+          Sat _ -> pure ([getNonError query], Just leaf)+          Unsat -> pure ([getNonError query], Nothing)           r -> internalError $ "Invalid solver result: " <> show r  -- | Extract constraints stored in Expr End nodes@@ -552,24 +594,24 @@   -> Maybe (Postcondition RealWorld)   -> m (Expr End, [VerifyResult]) verify solvers opts preState maybepost = do-  liftIO $ putStrLn "Exploring contract"+  conf <- readConfig+  let call = mconcat ["prefix 0x", getCallPrefix preState.state.calldata]+  when conf.debug $ liftIO $ putStrLn $ "   Exploring call " <> call    exprInter <- interpret (Fetch.oracle solvers opts.rpcInfo) opts.maxIter opts.askSmtIters opts.loopHeuristic preState runExpr-  conf <- readConfig   when conf.dumpExprs $ liftIO $ T.writeFile "unsimplified.expr" (formatExpr exprInter)   liftIO $ do-    putStrLn "Simplifying expression"+    when conf.debug $ putStrLn "   Simplifying expression"     let expr = if opts.simp then (Expr.simplify exprInter) else exprInter     when conf.dumpExprs $ T.writeFile "simplified.expr" (formatExpr expr) -    putStrLn $ "Explored contract (" <> show (Expr.numBranches expr) <> " branches)"+    when conf.debug $ putStrLn $ "   Exploration finished, " <> show (Expr.numBranches expr) <> " branch(es) to check in call " <> call      let flattened = flattenExpr expr     when (any isPartial flattened) $ do-      T.putStrLn ""-      T.putStrLn "WARNING: hevm was only able to partially explore the given contract due to the following issues:"-      T.putStrLn ""-      T.putStrLn . T.unlines . fmap (indent 2 . ("- " <>)) . fmap formatPartial . getPartials $ flattened+      T.putStrLn $ indent 3 "\x1b[33mWARNING\x1b[0m: hevm was only able to partially explore the call "+                  <> T.pack call <> " due to the following issue(s):"+      T.putStr . T.unlines . fmap (indent 5 . ("- " <>)) . fmap formatPartial . getPartials $ flattened      case maybepost of       Nothing -> pure (expr, [Qed ()])@@ -577,18 +619,23 @@         let           -- Filter out any leaves from `flattened` that can be statically shown to be safe           tocheck = flip map flattened $ \leaf -> (toPropsFinal leaf preState.constraints post, leaf)-          withQueries = filter canBeSat tocheck <&> \(a, leaf) -> (assertProps conf a, leaf)-        putStrLn $ "Checking for reachability of "-                     <> show (length withQueries)-                     <> " potential property violation(s)"+          withQueries = filter canBeSat tocheck <&> first (assertProps conf)+        when conf.debug $+          putStrLn $ "   Checking for reachability of " <> show (length withQueries)+                     <> " potential property violation(s) in call " <> call          -- Dispatch the remaining branches to the solver to check for violations         results <- flip mapConcurrently withQueries $ \(query, leaf) -> do           res <- checkSat solvers query+          when conf.debug $ putStrLn $ "   SMT result: " <> show res           pure (res, leaf)         let cexs = filter (\(res, _) -> not . isUnsat $ res) results+        when conf.debug $ putStrLn $ "   Found " <> show (length cexs) <> " potential counterexample(s) in call " <> call         pure $ if Prelude.null cexs then (expr, [Qed ()]) else (expr, fmap toVRes cexs)   where+    getCallPrefix :: Expr Buf -> String+    getCallPrefix (WriteByte (Lit 0) (LitByte a) (WriteByte (Lit 1) (LitByte b) (WriteByte (Lit 2) (LitByte c) (WriteByte (Lit 3) (LitByte d) _)))) = mconcat $ map (printf "%02x") [a,b,c,d]+    getCallPrefix _ = "unknown"     toProps leaf constr post = PNeg (post preState leaf) : constr <> extractProps leaf     toPropsFinal leaf constr post = if opts.simp then Expr.simplifyProps $ toProps leaf constr post                                                  else toProps leaf constr post@@ -598,9 +645,9 @@     toVRes :: (CheckSatResult, Expr End) -> VerifyResult     toVRes (res, leaf) = case res of       Sat model -> Cex (leaf, expandCex preState model)-      EVM.Solvers.Unknown -> Timeout leaf+      EVM.Solvers.Unknown _ -> EVM.SymExec.Unknown leaf+      EVM.Solvers.Error e -> EVM.SymExec.Error e       Unsat -> Qed ()-      Error e -> internalError $ "solver responded with error: " <> show e  expandCex :: VM Symbolic s -> SMTCex -> SMTCex expandCex prestate c = c { store = Map.union c.store concretePreStore }@@ -655,10 +702,8 @@   => SolverGroup -> [Expr End] -> [Expr End] -> m [EquivResult] equivalenceCheck' solvers branchesA branchesB = do       when (any isPartial branchesA || any isPartial branchesB) $ liftIO $ do-        putStrLn ""-        putStrLn "WARNING: hevm was only able to partially explore the given contract due to the following issues:"-        putStrLn ""-        T.putStrLn . T.unlines . fmap (indent 2 . ("- " <>)) . fmap formatPartial . nubOrd $ ((getPartials branchesA) <> (getPartials branchesB))+        putStrLn "\x1b[33mWARNING\x1b[0m: hevm was only able to partially explore the given contract due to the following issue(s):"+        T.putStr . T.unlines . fmap (indent 2 . ("- " <>)) . fmap formatPartial . nubOrd $ ((getPartials branchesA) <> (getPartials branchesB))        let allPairs = [(a,b) | a <- branchesA, b <- branchesB]       liftIO $ putStrLn $ "Found " <> show (length allPairs) <> " total pairs of endstates"@@ -679,7 +724,7 @@        let useful = foldr (\(_, b) n -> if b then n+1 else n) (0::Integer) results       liftIO $ putStrLn $ "Reuse of previous queries was Useful in " <> (show useful) <> " cases"-      case all isQed . fmap fst $ results of+      case all (isQed . fst) results of         True -> pure [Qed ()]         False -> pure $ filter (/= Qed ()) . fmap fst $ results   where@@ -713,8 +758,8 @@               -- potential race, but it doesn't matter for correctness               atomically $ readTVar knownUnsat >>= writeTVar knownUnsat . (props :)               pure (Qed (), False)-        (_, EVM.Solvers.Unknown) -> pure (Timeout (), False)-        (_, Error txt) -> internalError $ "solver returned: " <> (T.unpack txt)+        (_, EVM.Solvers.Unknown _) -> pure (EVM.SymExec.Unknown (), False)+        (_, EVM.Solvers.Error txt) -> pure (EVM.SymExec.Error txt, False)      -- Allows us to run it in parallel. Note that this (seems to) run it     -- from left-to-right, and with a max of K threads. This is in contrast to@@ -804,37 +849,35 @@ showModel :: Expr Buf -> (Expr End, CheckSatResult) -> IO () showModel cd (expr, res) = do   case res of-    Unsat -> pure () -- ignore unreachable branches-    Error e -> internalError $ "smt solver returned an error: " <> show e-    EVM.Solvers.Unknown -> do-      putStrLn "--- Branch ---"+    EVM.Solvers.Unsat -> pure () -- ignore unreachable branches+    EVM.Solvers.Error e -> do       putStrLn ""-      putStrLn "Unable to produce a model for the following end state:"+      putStrLn "--- Branch ---"+      putStrLn $ "Error during SMT solving, cannot check branch " <> e+    EVM.Solvers.Unknown reason -> do       putStrLn ""+      putStrLn "--- Branch ---"+      putStrLn $ "Unable to produce a model for the following end state due to '" <> reason <> "' :"       T.putStrLn $ indent 2 $ formatExpr expr       putStrLn ""     Sat cex -> do-      putStrLn "--- Branch ---"       putStrLn ""+      putStrLn "--- Branch ---"       putStrLn "Inputs:"-      putStrLn ""       T.putStrLn $ indent 2 $ formatCex cd Nothing cex-      putStrLn ""       putStrLn "End State:"-      putStrLn ""       T.putStrLn $ indent 2 $ formatExpr expr-      putStrLn ""   formatCex :: Expr Buf -> Maybe Sig -> SMTCex -> Text-formatCex cd sig m@(SMTCex _ _ _ store blockContext txContext) = T.unlines $+formatCex cd sig m@(SMTCex _ addrs _ store blockContext txContext) = T.unlines $   [ "Calldata:"   , indent 2 cd'-  , ""   ]   <> storeCex   <> txCtx   <> blockCtx+  <> addrsCex   where     -- we attempt to produce a model for calldata by substituting all variables     -- and buffers provided by the model into the original calldata expression.@@ -856,7 +899,6 @@               ("Addr " <> (T.pack . show $ key)                 <> ": " <> (T.pack $ show (Map.toList val))) : acc             ) mempty store-          , ""           ]      txCtx :: [Text]@@ -867,9 +909,18 @@         , indent 2 $ T.unlines $ Map.foldrWithKey (\key val acc ->             (showTxCtx key <> ": " <> (T.pack $ show val)) : acc           ) mempty (filterSubCtx txContext)-        , ""         ] +    addrsCex :: [Text]+    addrsCex+      | Map.null addrs = []+      | otherwise =+          [ "Addrs:"+          , indent 2 $ T.unlines $ Map.foldrWithKey (\key val acc ->+              ((T.pack . show $ key) <> ": " <> (T.pack $ show val)) : acc+            ) mempty addrs+          ]+     -- strips the frame arg from frame context vars to make them easier to read     showTxCtx :: Expr EWord -> Text     showTxCtx (TxValue) = "TxValue"@@ -893,7 +944,6 @@         , indent 2 $ T.unlines $ Map.foldrWithKey (\key val acc ->             (T.pack $ show key <> ": " <> show val) : acc           ) mempty txContext-        , ""         ]      prettyBuf :: Expr Buf -> Text@@ -1014,10 +1064,10 @@                else v           e -> e -getCex :: ProofResult a b c -> Maybe b+getCex :: ProofResult a b c d -> Maybe b getCex (Cex c) = Just c getCex _ = Nothing -getTimeout :: ProofResult a b c -> Maybe c-getTimeout (Timeout c) = Just c-getTimeout _ = Nothing+getUnknown :: ProofResult a b c d-> Maybe c+getUnknown (EVM.SymExec.Unknown c) = Just c+getUnknown _ = Nothing

src/EVM/Transaction.hs view

@@ -1,12 +1,12 @@ module EVM.Transaction where  import EVM (initialContract, ceilDiv)+import EVM.Expr qualified as Expr import EVM.FeeSchedule-import EVM.RLP-import EVM.Types import EVM.Format (hexText)+import EVM.RLP import EVM.Sign-import qualified EVM.Expr as Expr+import EVM.Types  import Optics.Core hiding (cons) @@ -23,16 +23,17 @@ import Numeric (showHex) import Witch (into, unsafeInto) -data AccessListEntry = AccessListEntry {-  address :: Addr,-  storageKeys :: [W256]-} deriving (Show, Generic)+data AccessListEntry = AccessListEntry+  { address :: Addr+  , storageKeys :: [W256]+  } deriving (Show, Generic)  instance JSON.ToJSON AccessListEntry -data TxType = LegacyTransaction-            | AccessListTransaction-            | EIP1559Transaction+data TxType+  = LegacyTransaction+  | AccessListTransaction+  | EIP1559Transaction   deriving (Show, Eq, Generic)  instance JSON.ToJSON TxType where@@ -42,39 +43,40 @@                AccessListTransaction -> "0x1" -- EIP2930  -data Transaction = Transaction {-    txdata            :: ByteString,-    gasLimit          :: Word64,-    gasPrice          :: Maybe W256,-    nonce             :: W256,-    r                 :: W256,-    s                 :: W256,-    toAddr            :: Maybe Addr,-    v                 :: W256,-    value             :: W256,-    txtype            :: TxType,-    accessList        :: [AccessListEntry],-    maxPriorityFeeGas :: Maybe W256,-    maxFeePerGas      :: Maybe W256,-    chainId           :: W256-} deriving (Show, Generic)+data Transaction = Transaction+  { txdata            :: ByteString+  , gasLimit          :: Word64+  , gasPrice          :: Maybe W256+  , nonce             :: W256+  , r                 :: W256+  , s                 :: W256+  , toAddr            :: Maybe Addr+  , v                 :: W256+  , value             :: W256+  , txtype            :: TxType+  , accessList        :: [AccessListEntry]+  , maxPriorityFeeGas :: Maybe W256+  , maxFeePerGas      :: Maybe W256+  , chainId           :: W256+  } deriving (Show, Generic)  instance JSON.ToJSON Transaction where-  toJSON t = JSON.object [ ("input",             (JSON.toJSON (ByteStringS t.txdata)))-                         , ("gas",               (JSON.toJSON $ "0x" ++ showHex (into @Integer $ t.gasLimit) ""))-                         , ("gasPrice",          (JSON.toJSON $ show $ fromJust $ t.gasPrice))-                         , ("v",                 (JSON.toJSON $ show $ (t.v)-27))-                         , ("r",                 (JSON.toJSON $ show $ t.r))-                         , ("s",                 (JSON.toJSON $ show $ t.s))-                         , ("to",                (JSON.toJSON $ t.toAddr))-                         , ("nonce",             (JSON.toJSON $ show $ t.nonce))-                         , ("value",             (JSON.toJSON $ show $ t.value))-                         , ("type",              (JSON.toJSON $ t.txtype))-                         , ("accessList",        (JSON.toJSON $ t.accessList))-                         , ("maxPriorityFeePerGas", (JSON.toJSON $ show $ fromJust $ t.maxPriorityFeeGas))-                         , ("maxFeePerGas",      (JSON.toJSON $ show $ fromJust $ t.maxFeePerGas))-                         , ("chainId",           (JSON.toJSON $ show t.chainId))-                         ]+  toJSON t = JSON.object+    [ ("input",             (JSON.toJSON (ByteStringS t.txdata)))+    , ("gas",               (JSON.toJSON $ "0x" ++ showHex (into @Integer $ t.gasLimit) ""))+    , ("gasPrice",          (JSON.toJSON $ show $ fromJust t.gasPrice))+    , ("v",                 (JSON.toJSON $ show $ (t.v)-27))+    , ("r",                 (JSON.toJSON $ show t.r))+    , ("s",                 (JSON.toJSON $ show t.s))+    , ("to",                (JSON.toJSON t.toAddr))+    , ("nonce",             (JSON.toJSON $ show t.nonce))+    , ("value",             (JSON.toJSON $ show t.value))+    , ("type",              (JSON.toJSON t.txtype))+    , ("accessList",        (JSON.toJSON t.accessList))+    , ("maxPriorityFeePerGas", (JSON.toJSON $ show $ fromJust t.maxPriorityFeeGas))+    , ("maxFeePerGas",      (JSON.toJSON $ show $ fromJust t.maxFeePerGas))+    , ("chainId",           (JSON.toJSON $ show t.chainId))+    ]  emptyTransaction :: Transaction emptyTransaction = Transaction { txdata = mempty@@ -133,41 +135,47 @@           EVM.RLP.List [BS $ word160Bytes accessEntry.address,                         EVM.RLP.List $ map rlpWordFull accessEntry.storageKeys]           ) accessList-        normalData = rlpList [rlpWord256 tx.nonce,-                              rlpWord256 gasPrice,-                              rlpWord256 (into tx.gasLimit),-                              to',-                              rlpWord256 tx.value,-                              BS tx.txdata]-        eip155Data = rlpList [rlpWord256 tx.nonce,-                              rlpWord256 gasPrice,-                              rlpWord256 (into tx.gasLimit),-                              to',-                              rlpWord256 tx.value,-                              BS tx.txdata,-                              rlpWord256 tx.chainId,-                              rlpWord256 0x0,-                              rlpWord256 0x0]-        eip1559Data = cons 0x02 $ rlpList [-          rlpWord256 tx.chainId,-          rlpWord256 tx.nonce,-          rlpWord256 maxPrio,-          rlpWord256 maxFee,-          rlpWord256 (into tx.gasLimit),-          to',-          rlpWord256 tx.value,-          BS tx.txdata,-          rlpAccessList]+        normalData = rlpList+          [ rlpWord256 tx.nonce+          , rlpWord256 gasPrice+          , rlpWord256 (into tx.gasLimit)+          , to'+          , rlpWord256 tx.value+          , BS tx.txdata+          ]+        eip155Data = rlpList+          [ rlpWord256 tx.nonce+          , rlpWord256 gasPrice+          , rlpWord256 (into tx.gasLimit)+          , to'+          , rlpWord256 tx.value+          , BS tx.txdata+          , rlpWord256 tx.chainId+          , rlpWord256 0x0+          , rlpWord256 0x0+          ]+        eip1559Data = cons 0x02 $ rlpList+          [ rlpWord256 tx.chainId+          , rlpWord256 tx.nonce+          , rlpWord256 maxPrio+          , rlpWord256 maxFee+          , rlpWord256 (into tx.gasLimit)+          , to'+          , rlpWord256 tx.value+          , BS tx.txdata+          , rlpAccessList+          ] -        eip2930Data = cons 0x01 $ rlpList [-          rlpWord256 tx.chainId,-          rlpWord256 tx.nonce,-          rlpWord256 gasPrice,-          rlpWord256 (into tx.gasLimit),-          to',-          rlpWord256 tx.value,-          BS tx.txdata,-          rlpAccessList]+        eip2930Data = cons 0x01 $ rlpList+          [ rlpWord256 tx.chainId+          , rlpWord256 tx.nonce+          , rlpWord256 gasPrice+          , rlpWord256 (into tx.gasLimit)+          , to'+          , rlpWord256 tx.value+          , BS tx.txdata+          , rlpAccessList+          ]  accessListPrice :: FeeSchedule Word64 -> [AccessListEntry] -> Word64 accessListPrice fs al =@@ -247,7 +255,8 @@ -- subtract gas payment from the origin, increment the nonce -- and pay receiving address initTx :: VM t s -> VM t s-initTx vm = let+initTx vm =+  let     toAddr   = vm.state.contract     origin   = vm.tx.origin     gasPrice = vm.tx.gasprice@@ -265,6 +274,6 @@          then Map.insert toAddr (toContract & (set #balance oldBalance))          else touchAccount toAddr)       $ preState-    in-      vm & #env % #contracts .~ initState-         & #tx % #txReversion .~ preState+  in+    vm & #env % #contracts .~ initState+       & #tx % #txReversion .~ preState

src/EVM/Traversals.hs view

@@ -6,8 +6,9 @@  import Prelude hiding (LT, GT) -import Control.Monad.Identity-import qualified Data.Map.Strict as Map+import Control.Monad (forM, void)+import Control.Monad.Identity (Identity(Identity), runIdentity)+import Data.Map.Strict qualified as Map import Data.List (foldl')  import EVM.Types@@ -30,20 +31,13 @@  foldEContract :: forall b . Monoid b => (forall a . Expr a -> b) -> b -> Expr EContract -> b foldEContract f _ g@(GVar _) = f g-foldEContract f acc (C code storage balance _)+foldEContract f acc (C code storage tStorage balance _)   =  acc   <> foldCode f code   <> foldExpr f mempty storage+  <> foldExpr f mempty tStorage   <> foldExpr f mempty balance -foldContract :: forall b . Monoid b => (forall a . Expr a -> b) -> b -> Contract -> b-foldContract f acc c-  =  acc-  <> foldCode f c.code-  <> foldExpr f mempty c.storage-  <> foldExpr f mempty c.origStorage-  <> foldExpr f mempty c.balance- foldCode :: forall b . Monoid b => (forall a . Expr a -> b) -> ContractCode -> b foldCode f = \case   RuntimeCode (ConcreteRuntimeCode _) -> mempty@@ -233,9 +227,44 @@   POr a b -> f $ POr (mapProp' f a) (mapProp' f b)   PImpl a b -> f $ PImpl (mapProp' f a) (mapProp' f b) ++mapPropM' :: forall m . (Monad m) => (Prop -> m Prop) -> Prop -> m Prop+mapPropM' f = \case+  PBool b -> f $ PBool b+  PEq a b -> f $ PEq a b+  PLT a b -> f $ PLT a b+  PGT a b -> f $ PGT a b+  PLEq a b -> f $ PLEq a b+  PGEq a b -> f $ PGEq a b+  PNeg a -> do+    x <- mapPropM' f a+    f $ PNeg x+  PAnd a b -> do+    x <- mapPropM' f a+    y <- mapPropM' f b+    f $ PAnd x y+  POr a b -> do+    x <- mapPropM' f a+    y <- mapPropM' f b+    f $ POr x y+  PImpl a b -> do+    x <- mapPropM' f a+    y <- mapPropM' f b+    f $ PImpl x y+ mapExpr :: (forall a . Expr a -> Expr a) -> Expr b -> Expr b mapExpr f expr = runIdentity (mapExprM (Identity . f) expr) +-- Like mapExprM but allows a function of type `Expr a -> m ()` to be passed+mapExprM_ ::  Monad m => (forall a . Expr a -> m ()) -> Expr b -> m ()+mapExprM_ f expr = void ret+  where+    ret = mapExprM (fUpd f) expr+    fUpd :: Monad m => (Expr a -> m ()) -> (Expr a -> m (Expr a))+    fUpd action e = do+      action e+      pure e+ mapExprM :: Monad m => (forall a . Expr a -> m (Expr a)) -> Expr b -> m (Expr b) mapExprM f expr = case expr of @@ -560,6 +589,16 @@     a' <- mapExprM f a     f (BufLength a') +-- Like mapPropM but allows a function of type `Expr a -> m ()` to be passed+mapPropM_ :: Monad m => (forall a . Expr a -> m ()) -> Prop -> m ()+mapPropM_ f expr = void ret+  where+    ret = mapPropM (fUpd f) expr+    fUpd :: Monad m => (Expr a -> m ()) -> (Expr a-> m (Expr a))+    fUpd action e = do+      action e+      pure e+ mapPropM :: Monad m => (forall a . Expr a -> m (Expr a)) -> Prop -> m Prop mapPropM f = \case   PBool b -> pure $ PBool b@@ -602,11 +641,12 @@  mapEContractM :: Monad m => (forall a . Expr a -> m (Expr a)) -> Expr EContract -> m (Expr EContract) mapEContractM _ g@(GVar _) = pure g-mapEContractM f (C code storage balance nonce) = do+mapEContractM f (C code storage tStorage balance nonce) = do   code' <- mapCodeM f code   storage' <- mapExprM f storage+  tStorage' <- mapExprM f tStorage   balance' <- mapExprM f balance-  pure $ C code' storage' balance' nonce+  pure $ C code' storage' tStorage' balance' nonce  mapContractM :: Monad m => (forall a . Expr a -> m (Expr a)) -> Contract -> m (Contract) mapContractM f c = do

src/EVM/Types.hs view

@@ -1,17 +1,17 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-}  {-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}-{-# LANGUAGE TypeFamilyDependencies #-}  module EVM.Types where  import GHC.Stack (HasCallStack, prettyCallStack, callStack) import Control.Arrow ((>>>))+import Control.Monad (mzero) import Control.Monad.ST (ST)-import Control.Monad.State.Strict (StateT, mzero)+import Control.Monad.State.Strict (StateT) import Crypto.Hash (hash, Keccak_256, Digest) import Data.Aeson import Data.Aeson qualified as JSON@@ -77,6 +77,7 @@ instance From Int256 Integer where from = fromIntegral instance From Nibble Int where from = fromIntegral instance From W256 Integer where from = fromIntegral+instance From W256 Word512 where from = fromIntegral instance From Word8 W256 where from = fromIntegral instance From Word8 Word256 where from = fromIntegral instance From Word32 W256 where from = fromIntegral@@ -218,9 +219,9 @@    -- control flow -  Partial        :: [Prop] -> Traces -> PartialExec -> Expr End-  Failure        :: [Prop] -> Traces -> EvmError -> Expr End-  Success        :: [Prop] -> Traces -> Expr Buf -> Map (Expr EAddr) (Expr EContract) -> Expr End+  Partial        :: [Prop] -> TraceContext -> PartialExec -> Expr End+  Failure        :: [Prop] -> TraceContext -> EvmError -> Expr End+  Success        :: [Prop] -> TraceContext -> Expr Buf -> Map (Expr EAddr) (Expr EContract) -> Expr End   ITE            :: Expr EWord -> Expr End -> Expr End -> Expr End    -- integers@@ -309,10 +310,11 @@   -- A restricted view of a contract that does not include extraneous metadata   -- from the full constructor defined in the VM state   C ::-    { code    :: ContractCode-    , storage :: Expr Storage-    , balance :: Expr EWord-    , nonce   :: Maybe W64+    { code     :: ContractCode+    , storage  :: Expr Storage+    , tStorage :: Expr Storage+    , balance  :: Expr EWord+    , nonce    :: Maybe W64     } -> Expr EContract    -- addresses@@ -515,6 +517,14 @@  -- Errors ------------------------------------------------------------------------------------------ +-- General error helper+type Err a = Either String a+getError :: Err a -> String+getError (Left a) = a+getError _ = internalError "getLeft on a Right"+getNonError :: Err a -> a+getNonError (Right a) = a+getNonError _ = internalError "getRight on a Left"  -- | Core EVM Error Types data EvmError@@ -536,13 +546,39 @@   | PrecompileFailure   | ReturnDataOutOfBounds   | NonceOverflow-  | BadCheatCode FunctionSelector+  | BadCheatCode String FunctionSelector   | NonexistentFork Int   deriving (Show, Eq, Ord) +evmErrToString :: EvmError -> String+evmErrToString = \case+  -- NOTE: error text made to closely match go-ethereum's errors.go file+  OutOfGas {}             -> "Out of gas"+  -- TODO "contract creation code storage out of gas" not handled+  CallDepthLimitReached   -> "Max call depth exceeded"+  BalanceTooLow {}        -> "Insufficient balance for transfer"+  -- TODO "contract address collision" not handled+  Revert {}               -> "Execution reverted"+  -- TODO "max initcode size exceeded" not handled+  MaxCodeSizeExceeded {}  -> "Max code size exceeded"+  BadJumpDestination      -> "Invalid jump destination"+  StateChangeWhileStatic  -> "Attempting to modify state while in static context"+  ReturnDataOutOfBounds   -> "Return data out of bounds"+  IllegalOverflow         -> "Gas uint64 overflow"+  UnrecognizedOpcode op   -> "Invalid opcode: 0x" <> showHex op ""+  NonceOverflow           -> "Nonce uint64 overflow"+  StackUnderrun           -> "Stack underflow"+  StackLimitExceeded      -> "Stack limit reached"+  InvalidMemoryAccess     -> "Write protection"+  (BadCheatCode err fun)  -> err <> " Cheatcode function selector: " <> show fun+  NonexistentFork fork    -> "Nonexistent fork: " <> show fork+  PrecompileFailure       -> "Precompile failure"+  err                     -> "hevm error: " <> show err++ -- | Sometimes we can only partially execute a given program data PartialExec-  = UnexpectedSymbolicArg { pc :: Int, msg  :: String, args  :: [SomeExpr] }+  = UnexpectedSymbolicArg { pc :: Int, opcode :: String, msg  :: String, args  :: [SomeExpr] }   | MaxIterationsReached  { pc :: Int, addr :: Expr EAddr }   | JumpIntoSymbolicCode  { pc :: Int, jumpDst :: Int }   deriving (Show, Eq, Ord)@@ -558,7 +594,8 @@   PleaseFetchContract :: Addr -> BaseState -> (Contract -> EVM t s ()) -> Query t s   PleaseFetchSlot     :: Addr -> W256 -> (W256 -> EVM t s ()) -> Query t s   PleaseAskSMT        :: Expr EWord -> [Prop] -> (BranchCondition -> EVM Symbolic s ()) -> Query Symbolic s-  PleaseDoFFI         :: [String] -> (ByteString -> EVM t s ()) -> Query t s+  PleaseDoFFI         :: [String] -> Map String String -> (ByteString -> EVM t s ()) -> Query t s+  PleaseReadEnv       :: String -> (String -> EVM t s ()) -> Query t s  -- | Execution could proceed down one of two branches data Choose s where@@ -580,8 +617,10 @@       (("<EVM.Query: ask SMT about "         ++ show condition ++ " in context "         ++ show constraints ++ ">") ++)-    PleaseDoFFI cmd _ ->-      (("<EVM.Query: do ffi: " ++ (show cmd)) ++)+    PleaseDoFFI cmd env _ ->+      (("<EVM.Query: do ffi: " ++ (show cmd) ++ " env: " ++ (show env)) ++)+    PleaseReadEnv variable _ ->+      (("<EVM.Query: read env: " ++ variable) ++)  instance Show (Choose s) where   showsPrec _ = \case@@ -624,6 +663,8 @@   , config         :: RuntimeConfig   , forks          :: Seq ForkState   , currentFork    :: Int+  , labels         :: Map Addr Text+  , osEnv          :: Map String String   }   deriving (Generic) @@ -650,7 +691,6 @@ -- | Configuration options that need to be consulted at runtime data RuntimeConfig = RuntimeConfig   { allowFFI :: Bool-  , overrideCaller :: Maybe (Expr EAddr)   , baseState :: BaseState   }   deriving (Show)@@ -670,7 +710,7 @@     { address         :: Expr EAddr     , codehash        :: Expr EWord     , createreversion :: Map (Expr EAddr) Contract-    , substate        :: SubState+    , subState        :: SubState     }   | CallContext     { target        :: Expr EAddr@@ -692,6 +732,7 @@   , accessedAddresses   :: Set (Expr EAddr)   , accessedStorageKeys :: Set (Expr EAddr, W256)   , refunds             :: [(Expr EAddr, Word64)]+  , createdContracts    :: Set (Expr EAddr)   -- in principle we should include logs here, but do not for now   }   deriving (Eq, Ord, Show)@@ -711,6 +752,8 @@   , gas          :: !(Gas t)   , returndata   :: Expr Buf   , static       :: Bool+  , overrideCaller :: Maybe (Expr EAddr)+  , resetCaller  :: Bool   }   deriving (Generic) @@ -735,7 +778,7 @@   , origin      :: Expr EAddr   , toAddr      :: Expr EAddr   , value       :: Expr EWord-  , substate    :: SubState+  , subState    :: SubState   , isCreate    :: Bool   , txReversion :: Map (Expr EAddr) Contract   }@@ -766,6 +809,7 @@ data Contract = Contract   { code        :: ContractCode   , storage     :: Expr Storage+  , tStorage    :: Expr Storage   , origStorage :: Expr Storage   , balance     :: Expr EWord   , nonce       :: Maybe W64@@ -896,16 +940,17 @@   deriving (Eq, Ord, Show, Generic)  -- | Wrapper type containing vm traces and the context needed to pretty print them properly-data Traces = Traces+data TraceContext = TraceContext   { traces :: Forest Trace   , contracts :: Map (Expr EAddr) Contract+  , labels :: Map Addr Text   }   deriving (Eq, Ord, Show, Generic) -instance Semigroup Traces where-  (Traces a b) <> (Traces c d) = Traces (a <> c) (b <> d)-instance Monoid Traces where-  mempty = Traces mempty mempty+instance Semigroup TraceContext where+  (TraceContext a b c) <> (TraceContext d e f) = TraceContext (a <> d) (b <> e) (c <> f)+instance Monoid TraceContext where+  mempty = TraceContext mempty mempty mempty   -- VM Initialization -------------------------------------------------------------------------------@@ -937,6 +982,8 @@   , create :: Bool   , txAccessList :: Map (Expr EAddr) [W256]   , allowFFI :: Bool+  , freshAddresses :: Int+  , beaconRoot :: W256   }  deriving instance Show (VMOpts Symbolic)@@ -1001,12 +1048,17 @@   | OpChainid   | OpSelfbalance   | OpBaseFee+  | OpBlobhash+  | OpBlobBaseFee   | OpPop+  | OpMcopy   | OpMload   | OpMstore   | OpMstore8   | OpSload   | OpSstore+  | OpTload+  | OpTstore   | OpJump   | OpJumpi   | OpPc@@ -1053,7 +1105,7 @@         T.decodeUtf8 . toStrict . toLazyByteString . byteStringHex  instance JSON.FromJSON ByteStringS where-  parseJSON (JSON.String x) = case BS16.decodeBase16' x of+  parseJSON (JSON.String x) = case BS16.decodeBase16Untyped (T.encodeUtf8 x) of                                 Left _ -> mzero                                 Right bs -> pure (ByteStringS bs)   parseJSON _ = mzero@@ -1131,7 +1183,7 @@   parseJSON v = do     s <- T.unpack <$> parseJSON v     case reads s of-      [(x, "")]  -> return x+      [(x, "")]  -> pure x       _          -> fail $ "invalid hex word (" ++ s ++ ")"  @@ -1210,18 +1262,10 @@   deriving (Num, Integral, Real, Ord, Enum, Eq, Bounded, Generic)  instance Show Nibble where-  show = (:[]) . intToDigit . fromIntegral-+  show = (:[]) . intToDigit . into  -- Conversions ------------------------------------------------------------------------------------- --toWord512 :: W256 -> Word512-toWord512 (W256 x) = fromHiAndLo 0 x--fromWord512 :: Word512 -> W256-fromWord512 x = W256 (loWord x)- maybeLitByte :: Expr Byte -> Maybe Word8 maybeLitByte (LitByte x) = Just x maybeLitByte _ = Nothing@@ -1243,7 +1287,7 @@ word256 :: ByteString -> Word256 word256 xs | BS.length xs == 1 =   -- optimize one byte pushes-  Word256 (Word128 0 0) (Word128 0 (fromIntegral $ BS.head xs))+  Word256 (Word128 0 0) (Word128 0 (into $ BS.head xs)) word256 xs = case Cereal.runGet m (padLeft 32 xs) of                Left _ -> internalError "should not happen"                Right x -> x@@ -1269,11 +1313,11 @@  word256Bytes :: W256 -> ByteString word256Bytes (W256 (Word256 (Word128 a b) (Word128 c d))) =-  Cereal.encode a <> Cereal.encode b <> Cereal.encode c <> Cereal.encode d+  Cereal.encode (a, b, c, d)  word160Bytes :: Addr -> ByteString word160Bytes (Addr (Word160 a (Word128 b c))) =-  Cereal.encode a <> Cereal.encode b <> Cereal.encode c+  Cereal.encode (a, b, c)  -- Get first and second Nibble from byte hi, lo :: Word8 -> Nibble@@ -1299,12 +1343,6 @@     then let (W256 (Word256 _ (Word128 _ n'))) = n in Just n'     else Nothing -toInt :: W256 -> Maybe Int-toInt n =-  if n <= unsafeInto (maxBound :: Int)-    then let (W256 (Word256 _ (Word128 _ n'))) = n in Just (fromIntegral n')-    else Nothing- bssToBs :: ByteStringS -> ByteString bssToBs (ByteStringS bs) = bs @@ -1318,7 +1356,7 @@     >>> BA.convert  word32 :: [Word8] -> Word32-word32 xs = sum [ fromIntegral x `shiftL` (8*n)+word32 xs = sum [ into x `shiftL` (8*n)                 | (n, x) <- zip [0..] (reverse xs) ]  keccak :: Expr Buf -> Expr EWord@@ -1340,7 +1378,7 @@ -- Utils -------------------------------------------------------------------------------------------  {- HLINT ignore internalError -}-internalError:: HasCallStack => [Char] -> a+internalError :: HasCallStack => [Char] -> a internalError m = error $ "Internal Error: " ++ m ++ " -- " ++ (prettyCallStack callStack)  concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]

src/EVM/UnitTest.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE ImplicitParams #-}  module EVM.UnitTest where@@ -8,29 +7,30 @@ import EVM.SMT import EVM.Solvers import EVM.Dapp+import EVM.Effects import EVM.Exec-import EVM.Expr (readStorage') import EVM.Expr qualified as Expr import EVM.FeeSchedule (feeSchedule) import EVM.Fetch qualified as Fetch import EVM.Format import EVM.Solidity-import EVM.SymExec (defaultVeriOpts, symCalldata, verify, isQed, extractCex, runExpr, prettyCalldata, panicMsg, VeriOpts(..), flattenExpr)+import EVM.SymExec (defaultVeriOpts, symCalldata, verify, isQed, extractCex, prettyCalldata, panicMsg, VeriOpts(..), flattenExpr, isUnknown, isError, groupIssues) import EVM.Types import EVM.Transaction (initTx) import EVM.Stepper (Stepper) import EVM.Stepper qualified as Stepper +import Control.Monad (void, when, forM, forM_) import Control.Monad.ST (RealWorld, ST, stToIO)-import Optics.Core hiding (elements)+import Control.Monad.State.Strict (execState, get, put, liftIO)+import Optics.Core import Optics.State import Optics.State.Operators-import Control.Monad.State.Strict hiding (state)-import Data.ByteString.Lazy qualified as BSLazy import Data.Binary.Get (runGet) import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS+import Data.ByteString.Lazy qualified as BSLazy import Data.Decimal (DecimalRaw(..))-import Data.Either (isRight, rights, lefts) import Data.Foldable (toList) import Data.Map (Map) import Data.Map qualified as Map@@ -43,7 +43,6 @@ import GHC.Natural import System.IO (hFlush, stdout) import Witch (unsafeInto, into)-import EVM.Effects  data UnitTestOptions s = UnitTestOptions   { rpcInfo     :: Fetch.RpcInfo@@ -57,6 +56,7 @@   , dapp        :: DappInfo   , testParams  :: TestVMParams   , ffiAllowed  :: Bool+  , checkFailBit:: Bool   }  data TestVMParams = TestVMParams@@ -92,7 +92,17 @@  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 $ Text.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 makeVeriOpts opts =@@ -104,15 +114,19 @@ -- | Top level CLI endpoint for hevm test unitTest :: App m => UnitTestOptions RealWorld -> Contracts -> m Bool unitTest opts (Contracts cs) = do-  let unitTests = findUnitTests opts.match $ Map.elems cs-  results <- concatMapM (runUnitTestContract opts cs) unitTests+  let unitTestContrs = findUnitTests opts.match $ Map.elems cs+  conf <- readConfig+  when conf.debug $ liftIO $ do+    putStrLn $ "Found " ++ show (length unitTestContrs) ++ " unit test contract(s) to test:"+    let x = map (\(a,b) -> "  --> " <> a <> "  ---  functions: " <> (Text.pack $ show b)) unitTestContrs+    putStrLn $ unlines $ map Text.unpack x+  results <- concatMapM (runUnitTestContract opts cs) unitTestContrs   pure $ and results  -- | Assuming a constructor is loaded, this stepper will run the constructor -- to create the test contract, give it an initial balance, and run `setUp()'. initializeUnitTest :: UnitTestOptions s -> SolcContract -> Stepper Concrete s () initializeUnitTest opts theContract = do-   let addr = opts.testParams.address    Stepper.evm $ do@@ -129,7 +143,6 @@     -- call setUp(), if it exists, to initialize the test contract     let theAbi = theContract.abiMap         setUp  = abiKeccak (encodeUtf8 "setUp()")-     when (isJust (Map.lookup setUp theAbi)) $ do       abiCall opts.testParams (Left ("setUp()", emptyAbi))       popTrace@@ -151,7 +164,7 @@   opts@(UnitTestOptions {..}) contractMap (name, testSigs) = do    -- Print a header-  liftIO $ putStrLn $ "Running " ++ show (length testSigs) ++ " tests for " ++ unpack name+  liftIO $ putStrLn $ "Checking " ++ show (length testSigs) ++ " function(s) in contract " ++ unpack name    -- Look for the wanted contract by name from the Solidity info   case Map.lookup name contractMap of@@ -171,53 +184,39 @@       case vm1.result of         Just (VMFailure _) -> liftIO $ do           Text.putStrLn "\x1b[31m[BAIL]\x1b[0m setUp() "-          tick "\n"           tick $ failOutput vm1 opts "setUp()"           pure [False]         Just (VMSuccess _) -> do-          -- Run all the test cases and print their status-          details <- forM testSigs $ \s -> do-            (result, detail) <- symRun opts vm1 s-            liftIO $ Text.putStrLn result-            pure detail--          let running = rights details-              bailing = lefts details--          liftIO $ do-            tick "\n"-            tick (Text.unlines (filter (not . Text.null) running))-            tick (Text.unlines bailing)--          pure $ fmap isRight details+          forM testSigs $ \s -> symRun opts vm1 s         _ -> internalError "setUp() did not end with a result"  -- | Define the thread spawner for symbolic tests-symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m (Text, Either Text Text)+symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m Bool symRun opts@UnitTestOptions{..} vm (Sig testName types) = do-    let cd = symCalldata testName types [] (AbstractBuf "txdata")-        shouldFail = "proveFail" `isPrefixOf` testName-        testContract store = fromMaybe (internalError "test contract not found in state") (Map.lookup vm.state.contract store)+    let callSig = testName <> "(" <> (Text.intercalate "," (map abiTypeSolidity types)) <> ")"+    liftIO $ putStrLn $ "\x1b[96m[RUNNING]\x1b[0m " <> Text.unpack callSig+    let cd = symCalldata callSig types [] (AbstractBuf "txdata")+        shouldFail = "proveFail" `isPrefixOf` callSig      -- define postcondition depending on `shouldFail`-    -- We directly encode the failure conditions from failed() in ds-test since this is easier to encode than a call into failed()-    -- we need to read from slot 0 in the test contract and mask it with 0x10 to get the value of _failed-    -- we don't need to do this when reading the failed from the cheatcode address since we don't do any packing there-    let failed store = case Map.lookup cheatCode store of-          Just cheatContract -> readStorage' (Lit 0x6661696c65640000000000000000000000000000000000000000000000000000) cheatContract.storage .== Lit 1-          Nothing -> And (readStorage' (Lit 0) (testContract store).storage) (Lit 2) .== Lit 2+    let testContract store = fromMaybe (internalError "test contract not found in state") (Map.lookup vm.state.contract store)+        failed store = case Map.lookup cheatCode store of+          Just cheatContract -> Expr.readStorage' (Lit 0x6661696c65640000000000000000000000000000000000000000000000000000) cheatContract.storage .== Lit 1+          Nothing -> And (Expr.readStorage' (Lit 0) (testContract store).storage) (Lit 2) .== Lit 2         postcondition = curry $ case shouldFail of           True -> \(_, post) -> case post of-                                  Success _ _ _ store -> failed store-                                  _ -> PBool True+            Success _ _ _ store -> if opts.checkFailBit then failed store else PBool False+            _ -> PBool True           False -> \(_, post) -> case post of-                                   Success _ _ _ store -> PNeg (failed store)-                                   Failure _ _ (Revert msg) -> case msg of-                                     ConcreteBuf b -> PBool $ b /= panicMsg 0x01-                                     b -> b ./= ConcreteBuf (panicMsg 0x01)-                                   Failure _ _ _ -> PBool True-                                   Partial _ _ _ -> PBool True-                                   _ -> internalError "Invalid leaf node"+            Success _ _ _ store -> if opts.checkFailBit then PNeg (failed store) else PBool True+            Failure _ _ (Revert msg) -> case msg of+              ConcreteBuf b ->+                if (BS.isPrefixOf (selector "Error(string)") b) || b == panicMsg 0x01 then PBool False+                else PBool True+              b -> b ./= ConcreteBuf (panicMsg 0x01)+            Failure _ _ _ -> PBool True+            Partial _ _ _ -> PBool True+            _ -> internalError "Invalid leaf node"      vm' <- Stepper.interpret (Fetch.oracle solvers rpcInfo) vm $       Stepper.evm $ do@@ -230,71 +229,63 @@     (e, results) <- verify solvers (makeVeriOpts opts) (symbolify vm') (Just postcondition)     let allReverts = not . (any Expr.isSuccess) . flattenExpr $ e +    conf <- readConfig+    when conf.debug $ liftIO $ forM_ (filter Expr.isFailure (flattenExpr e)) $ \case+      (Failure _ _ a) ->  putStrLn $ "   -> debug of func: " <> Text.unpack testName <> " Failure at the end of expr: " <> show a;+      _ -> internalError "cannot be, filtered for failure"+    when (any isUnknown results || any isError results) $ liftIO $ do+      putStrLn $ "      \x1b[33mWARNING\x1b[0m: hevm was only able to partially explore the test " <> Text.unpack testName <> " due to: ";+      forM_ (groupIssues (filter isError results)) $ \(num, str) -> putStrLn $ "      " <> show num <> "x -> " <> str+      forM_ (groupIssues (filter isUnknown results)) $ \(num, str) -> putStrLn $ "      " <> show num <> "x -> " <> str+     -- display results     if all isQed results     then if allReverts && (not shouldFail)-         then pure ("\x1b[31m[FAIL]\x1b[0m " <> testName, Left $ allBranchRev testName)-         else pure ("\x1b[32m[PASS]\x1b[0m " <> testName, Right "")+         then do+           liftIO $ putStr $ "   \x1b[31m[FAIL]\x1b[0m " <> Text.unpack testName <> "\n" <> Text.unpack allBranchRev+           pure False+         else do+           liftIO $ putStr $ "   \x1b[32m[PASS]\x1b[0m " <> Text.unpack testName <> "\n"+           pure True     else do+      -- not all is Qed       let x = mapMaybe extractCex results       let y = symFailure opts testName (fst cd) types x-      pure ("\x1b[31m[FAIL]\x1b[0m " <> testName, Left y)+      liftIO $ putStr $ "   \x1b[31m[FAIL]\x1b[0m " <> Text.unpack testName <> "\n" <> Text.unpack y+      pure False -allBranchRev :: Text -> Text-allBranchRev testName = Text.unlines-  [ "Failure: " <> testName-  , ""-  , indentLines 2 $ Text.unlines-      [ "No reachable assertion violations, but all branches reverted"-      , "Prefix this testname with `proveFail` if this is expected"+allBranchRev :: Text+allBranchRev = intercalate "\n"+  [ Text.concat $ indentLines 3 <$>+      [ "Reason:"+      , "  No reachable assertion violations, but all branches reverted"+      , "  Prefix this testname with `proveFail` if this is expected"       ]   ] symFailure :: UnitTestOptions RealWorld -> Text -> Expr Buf -> [AbiType] -> [(Expr End, SMTCex)] -> Text symFailure UnitTestOptions {..} testName cd types failures' =   mconcat-    [ "Failure: "-    , testName-    , "\n\n"-    , intercalate "\n" $ indentLines 2 . mkMsg <$> failures'+    [ Text.concat $ indentLines 3 . mkMsg <$> failures'     ]     where       showRes = \case         Success _ _ _ _ -> if "proveFail" `isPrefixOf` testName                            then "Successful execution"-                           else "Failed: DSTest Assertion Violation"+                           else "Failed: Test Assertion Violation"         res ->-          let ?context = DappContext { info = dapp, env = traceContext res}+          let ?context = dappContext (traceContext res)           in Text.pack $ prettyvmresult res-      mkMsg (leaf, cex) = Text.unlines+      mkMsg (leaf, cex) = intercalate "\n" $         ["Counterexample:"-        ,""         ,"  result:   " <> showRes leaf-        ,"  calldata: " <> let ?context =  DappContext dapp (traceContext leaf)+        ,"  calldata: " <> let ?context = dappContext (traceContext leaf)                            in prettyCalldata cex cd testName types-        , case verbose of-            Just _ -> Text.unlines-              [ ""-              , indentLines 2 (showTraceTree' dapp leaf)-              ]-            _ -> ""-        ]--execSymTest :: UnitTestOptions RealWorld -> ABIMethod -> (Expr Buf, [Prop]) -> Stepper Symbolic RealWorld (Expr End)-execSymTest UnitTestOptions{ .. } method cd = do-  -- Set up the call to the test method-  Stepper.evm $ do-    makeTxCall testParams cd-    pushTrace (EntryTrace method)-  -- Try running the test method-  runExpr--checkSymFailures :: VMOps t => UnitTestOptions RealWorld -> Stepper t RealWorld (VM t RealWorld)-checkSymFailures UnitTestOptions { .. } = do-  -- Ask whether any assertions failed-  Stepper.evm $ do-    popTrace-    abiCall testParams (Left ("failed()", emptyAbi))-  Stepper.runFully+        ] <> verbText leaf+      verbText leaf = case verbose of+            Just _ -> [Text.unlines [ indentLines 2 (showTraceTree' dapp leaf)]]+            _ -> mempty+      dappContext TraceContext { contracts, labels } =+        DappContext { info = dapp, contracts, labels }  indentLines :: Int -> Text -> Text indentLines n s =@@ -303,7 +294,9 @@  passOutput :: VM t s -> UnitTestOptions s -> Text -> Text passOutput vm UnitTestOptions { .. } testName =-  let ?context = DappContext { info = dapp, env = vm.env.contracts }+  let ?context = DappContext { info = dapp+                             , contracts = vm.env.contracts+                             , labels = vm.labels }   in let v = fromMaybe 0 verbose   in if (v > 1) then     mconcat@@ -318,7 +311,9 @@  failOutput :: VM t s -> UnitTestOptions s -> Text -> Text failOutput vm UnitTestOptions { .. } testName =-  let ?context = DappContext { info = dapp, env = vm.env.contracts }+  let ?context = DappContext { info = dapp+                             , contracts = vm.env.contracts+                             , labels = vm.labels }   in mconcat   [ "Failure: "   , fromMaybe "" (stripSuffix "()" testName)@@ -450,6 +445,8 @@            , baseState = EmptyBase            , txAccessList = mempty -- TODO: support unit test access lists???            , allowFFI = ffiAllowed+           , freshAddresses = 0+           , beaconRoot = 0            }   let creator =         initialContract (RuntimeCode (ConcreteRuntimeCode ""))

test/BlockchainTests.hs view

@@ -1,8 +1,8 @@ module Main where -import EVM.Test.BlockchainTests qualified  as BlockchainTests import Test.Tasty import EVM.Effects+import EVM.Test.BlockchainTests qualified as BlockchainTests  testEnv :: Env testEnv = Env { config = defaultConfig }

test/EVM/Test/BlockchainTests.hs view

@@ -1,14 +1,15 @@ module EVM.Test.BlockchainTests where -import EVM (initialContract, makeVm)+import EVM (initialContract, makeVm, setEIP4788Storage) import EVM.Concrete qualified as EVM import EVM.FeeSchedule (feeSchedule) 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(..))+import EVM.Test.Tracing (interpretWithTrace, VMTrace, compareTraces, EVMToolTraceOutput(..), decodeTraceOutputHelper)  import Optics.Core import Control.Arrow ((***), (&&&))@@ -23,7 +24,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy qualified as LazyByteString-import Data.List (isInfixOf)+import Data.List (isInfixOf, isPrefixOf) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (fromJust, fromMaybe, isNothing, isJust)@@ -31,6 +32,8 @@ import System.Environment (lookupEnv, getEnv) import System.FilePath.Find qualified as Find import System.FilePath.Posix (makeRelative, (</>))+import System.Process (readProcessWithExitCode)+import GHC.IO.Exception (ExitCode(ExitSuccess)) import Witch (into, unsafeInto) import Witherable (Filterable, catMaybes) @@ -49,6 +52,7 @@   , number      :: W256   , timestamp   :: W256   , txs         :: [Transaction]+  , beaconRoot  :: W256   } deriving Show  data Case = Case@@ -79,7 +83,7 @@   let testsDir = "BlockchainTests/GeneralStateTests"   let dir = repo </> testsDir   jsonFiles <- liftIO $ Find.find Find.always (Find.extension Find.==? ".json") dir-  liftIO $ putStrLn "Loading and parsing json files from ethereum-tests..."+  liftIO $ putStrLn $ "Loading and parsing json files from ethereum-tests from " <> show dir   isCI <- liftIO $ isJust <$> lookupEnv "CI"   let problematicTests = if isCI then commonProblematicTests <> ciProblematicTests else commonProblematicTests   let ignoredFiles = if isCI then ciIgnoredFiles else []@@ -90,16 +94,18 @@ testsFromFile   :: forall m . App m   => String -> Map String (TestTree -> TestTree) -> m [TestTree]-testsFromFile file problematicTests = do-  parsed <- parseBCSuite <$> (liftIO $ LazyByteString.readFile file)+testsFromFile fname problematicTests = do+  fContents <- liftIO $ LazyByteString.readFile fname+  let parsed = parseBCSuite fContents+  liftIO $ putStrLn $ "Parsed " <> fname   case parsed of-   Left "No cases to check." -> pure [] -- error "no-cases ok"-   Left _err -> pure [] -- error _err-   Right allTests -> mapM runTest (Map.toList allTests)+    Left "No cases to check." -> pure []+    Left _err -> pure []+    Right allTests -> mapM runTest $ Map.toList allTests   where-    runTest :: (String , Case) -> m TestTree+    runTest :: (String, Case) -> m TestTree     runTest (name, x) = do-      exec <- toIO $ runVMTest True (name, x)+      exec <- toIO $ runVMTest x       pure $ testCase' name exec     testCase' :: String -> Assertion -> TestTree     testCase' name assertion =@@ -113,76 +119,105 @@  commonProblematicTests :: Map String (TestTree -> TestTree) commonProblematicTests = Map.fromList-  [ ("loopMul_d0g0v0_Shanghai", ignoreTestBecause "hevm is too slow")-  , ("loopMul_d1g0v0_Shanghai", ignoreTestBecause "hevm is too slow")-  , ("loopMul_d2g0v0_Shanghai", ignoreTestBecause "hevm is too slow")-  , ("CALLBlake2f_MaxRounds_d0g0v0_Shanghai", ignoreTestBecause "very slow, bypasses timeout due time spent in FFI")+  [ ("loopMul_d0g0v0_Cancun", ignoreTestBecause "hevm is too slow")+  , ("loopMul_d1g0v0_Cancun", ignoreTestBecause "hevm is too slow")+  , ("loopMul_d2g0v0_Cancun", ignoreTestBecause "hevm is too slow")+  , ("CALLBlake2f_MaxRounds_d0g0v0_Cancun", ignoreTestBecause "very slow, bypasses timeout due time spent in FFI")++  , ("15_tstoreCannotBeDosd_d0g0v0_Cancun", ignoreTestBecause "slow test")+  , ("21_tstoreCannotBeDosdOOO_d0g0v0_Cancun", ignoreTestBecause "slow test")++  -- TODO: implement point evaluation, 0xa precompile, EIP-4844, Cancun+  , ("idPrecomps_d9g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d117g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d12g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d135g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d153g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d171g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d189g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d207g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d225g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d243g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d261g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d279g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d27g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d297g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d315g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d333g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d351g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d369g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d387g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d45g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d63g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d81g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("precompsEIP2929Cancun_d99g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("makeMoney_d0g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")+  , ("failed_tx_xcf416c53_d0g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")   ]  ciProblematicTests :: Map String (TestTree -> TestTree) ciProblematicTests = Map.fromList-  [ ("Return50000_d0g1v0_Shanghai", ignoreTest)-  , ("Return50000_2_d0g1v0_Shanghai", ignoreTest)-  , ("randomStatetest177_d0g0v0_Shanghai", ignoreTest)-  , ("static_Call50000_d0g0v0_Shanghai", ignoreTest)-  , ("static_Call50000_d1g0v0_Shanghai", ignoreTest)-  , ("static_Call50000bytesContract50_1_d1g0v0_Shanghai", ignoreTest)-  , ("static_Call50000bytesContract50_2_d1g0v0_Shanghai", ignoreTest)-  , ("static_Return50000_2_d0g0v0_Shanghai", ignoreTest)-  , ("loopExp_d10g0v0_Shanghai", ignoreTest)-  , ("loopExp_d11g0v0_Shanghai", ignoreTest)-  , ("loopExp_d12g0v0_Shanghai", ignoreTest)-  , ("loopExp_d13g0v0_Shanghai", ignoreTest)-  , ("loopExp_d14g0v0_Shanghai", ignoreTest)-  , ("loopExp_d8g0v0_Shanghai", ignoreTest)-  , ("loopExp_d9g0v0_Shanghai", ignoreTest)+  [ ("Return50000_d0g1v0_Cancun", ignoreTest)+  , ("Return50000_2_d0g1v0_Cancun", ignoreTest)+  , ("randomStatetest177_d0g0v0_Cancun", ignoreTest)+  , ("static_Call50000_d0g0v0_Cancun", ignoreTest)+  , ("static_Call50000_d1g0v0_Cancun", ignoreTest)+  , ("static_Call50000bytesContract50_1_d1g0v0_Cancun", ignoreTest)+  , ("static_Call50000bytesContract50_2_d1g0v0_Cancun", ignoreTest)+  , ("static_Return50000_2_d0g0v0_Cancun", ignoreTest)+  , ("loopExp_d10g0v0_Cancun", ignoreTest)+  , ("loopExp_d11g0v0_Cancun", ignoreTest)+  , ("loopExp_d12g0v0_Cancun", ignoreTest)+  , ("loopExp_d13g0v0_Cancun", ignoreTest)+  , ("loopExp_d14g0v0_Cancun", ignoreTest)+  , ("loopExp_d8g0v0_Cancun", ignoreTest)+  , ("loopExp_d9g0v0_Cancun", ignoreTest)   ] -runVMTest-  :: App m-  => Bool -> (String, Case) -> m ()-runVMTest diffmode (_name, x) = do+runVMTest :: App m => Case -> m ()+runVMTest x = do+  -- traceVsGeth fname name x   vm0 <- liftIO $ vmForCase x   result <- EVM.Stepper.interpret (EVM.Fetch.zero 0 (Just 0)) vm0 EVM.Stepper.runFully   writeTrace result-  maybeReason <- checkExpectation diffmode x result+  maybeReason <- checkExpectation x result   liftIO $ forM_ maybeReason assertFailure   -- | Run a vm test and output a geth style per opcode trace-traceVMTest-  :: App m-  => String -> String -> m [VMTrace]-traceVMTest file test = do-  repo <- liftIO $ getEnv "HEVM_ETHEREUM_TESTS_REPO"-  allTests <- parseBCSuite <$> (liftIO $ LazyByteString.readFile (repo </> file))-  let x = case filter (\(name, _) -> name == test) $ Map.toList (getRight allTests) of-        [(_, x')] -> x'-        _ -> internalError "test not found"+traceVMTest :: App m => Case -> m [VMTrace]+traceVMTest x = do   vm0 <- liftIO $ vmForCase x   (_, (_, ts)) <- runStateT (interpretWithTrace (EVM.Fetch.zero 0 (Just 0)) EVM.Stepper.runFully) (vm0, [])   pure ts-    where-      getRight :: Either a b -> b-      getRight (Right a) = a-      getRight (Left _) = error "Not allowed" --- | Read a geth trace from disk-readTrace :: FilePath -> IO (Either String EVMToolTraceOutput)-readTrace = JSON.eitherDecodeFileStrict- -- | given a path to a test file, a test case from within that file, and a trace from geth from running that test, compare the traces and show where we differ -- This would need a few tweaks to geth to make this really usable (i.e. evm statetest show allow running a single test from within the test file).-traceVsGeth-  :: App m-  => String -> String -> FilePath -> m ()-traceVsGeth file test gethTrace = do-  hevm <- traceVMTest file test-  decodedContents <- liftIO (JSON.decodeFileStrict gethTrace :: IO (Maybe EVMToolTraceOutput))+traceVsGeth :: App m => String -> String -> Case -> m ()+traceVsGeth fname name x = do+  liftIO $ putStrLn "-> Running `evm --json blocktest` tool."+  (exitCode, evmtoolStdout, evmtoolStderr) <- liftIO $ readProcessWithExitCode "evm" [+                               "--json"+                               , "blocktest"+                               , "--run", name+                               , fname+                               ] ""+  when (exitCode /= ExitSuccess) $ liftIO $ do+    putStrLn $ "evmtool exited with code " <> show exitCode+    putStrLn $ "evmtool stderr output:" <> show evmtoolStderr+    putStrLn $ "evmtool stdout output:" <> show evmtoolStdout+  hevm <- traceVMTest x+  liftIO $ writeFile "trace.jsonl" $ filterInfoLines evmtoolStderr+  decodedContents <- liftIO $ decodeTraceOutputHelper "trace.jsonl"   let EVMToolTraceOutput ts _ = fromJust decodedContents+  liftIO $ putStrLn "Comparing traces."   _ <- liftIO $ compareTraces hevm ts   pure () +  where+    filterInfoLines :: String -> String+    filterInfoLines input = unlines $ filter (not . isPrefixOf "INFO") (lines input)+ splitEithers :: (Filterable f) => f (Either a b) -> (f a, f b) splitEithers =   (catMaybes *** catMaybes)@@ -193,48 +228,47 @@ fromConcrete (ConcreteStore s) = s fromConcrete s = internalError $ "unexpected abstract store: " <> show s -checkStateFail :: Bool -> Case -> VM Concrete RealWorld -> (Bool, Bool, Bool, Bool) -> IO String-checkStateFail diff x vm (okMoney, okNonce, okData, okCode) = do+checkStateFail :: Case -> VM Concrete RealWorld -> (Bool, Bool, Bool, Bool) -> IO String+checkStateFail x vm (okBal, okNonce, okData, okCode) = do   let     printContracts :: Map Addr Contract -> IO ()     printContracts cs = putStrLn $ Map.foldrWithKey (\k c acc ->-      acc ++ show k ++ " : "-                   ++ (show $ fromJust $ c.nonce) ++ " "+      acc ++ "-->" <> show k ++ " : "+                   ++ (show $ fromJust c.nonce) ++ " "                    ++ (show $ fromJust $ maybeLitWord c.balance) ++ " "-                   ++ (show $ fromConcrete $ c.storage)+                   ++ (show $ fromConcrete c.storage)+                   ++ (show $ fromConcrete c.tStorage)         ++ "\n") "" cs      reason = map fst (filter (not . snd)-        [ ("bad-state",       okMoney || okNonce || okData  || okCode)-        , ("bad-balance", not okMoney || okNonce || okData  || okCode)-        , ("bad-nonce",   not okNonce || okMoney || okData  || okCode)-        , ("bad-storage", not okData  || okMoney || okNonce || okCode)-        , ("bad-code",    not okCode  || okMoney || okNonce || okData)+        [ ("bad-state",       okBal   || okNonce || okData  || okCode)+        , ("bad-balance", not okBal   || okNonce || okData  || okCode)+        , ("bad-nonce",   not okNonce || okBal   || okData  || okCode)+        , ("bad-storage", not okData  || okBal   || okNonce || okCode)+        , ("bad-code",    not okCode  || okBal   || okNonce || okData)         ])     check = x.checkContracts     expected = x.testExpectation     actual = fmap (clearZeroStorage . clearOrigStorage) $ forceConcreteAddrs vm.env.contracts -  when diff $ do-    putStr (unwords reason)-    putStrLn "\nPre balance/state: "-    printContracts check-    putStrLn "\nExpected balance/state: "-    printContracts expected-    putStrLn "\nActual balance/state: "-    printContracts actual+  putStrLn $ "-> Failing because of: " <> (unwords reason)+  putStrLn "-> Pre balance/state: "+  printContracts check+  putStrLn "-> Expected balance/state: "+  printContracts expected+  putStrLn "-> Actual balance/state: "+  printContracts actual   pure (unwords reason)  checkExpectation   :: App m-  => Bool -> Case -> VM Concrete RealWorld -> m (Maybe String)-checkExpectation diff x vm = do+  => Case -> VM Concrete RealWorld -> m (Maybe String)+checkExpectation x vm = do   let expectation = x.testExpectation-      (okState, b2, b3, b4, b5) = checkExpectedContracts vm expectation-  if okState then+      (okState, okBal, okNonce, okStor, okCode) = checkExpectedContracts vm expectation+  if okState then do     pure Nothing-  else liftIO $-    Just <$> checkStateFail diff x vm (b2, b3, b4, b5)+  else liftIO $ Just <$> checkStateFail x vm (okBal, okNonce, okStor, okCode)  -- quotient account state by nullness (~=) :: Map Addr Contract -> Map Addr Contract -> Bool@@ -247,12 +281,12 @@  (===) :: Contract -> Contract -> Bool c1 === c2 =-  codeEqual && storageEqual && (c1 ^. #balance == c2 ^. #balance) && (c1 ^. #nonce ==  c2 ^. #nonce)+  codeEqual && storageEqual && c1.balance == c2.balance && c1.nonce == c2.nonce   where     storageEqual = c1.storage == c2.storage-    codeEqual = case (c1 ^. #code, c2 ^. #code) of+    codeEqual = case (c1.code, c2.code) of       (RuntimeCode a', RuntimeCode b') -> a' == b'-      _ -> internalError "unexpected code"+      codes -> internalError ("unexpected code: \n" <> show codes)  checkExpectedContracts :: VM Concrete RealWorld -> Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool) checkExpectedContracts vm expected =@@ -274,7 +308,7 @@   _ -> internalError "Internal Error: unexpected abstract store"  clearStorage :: Contract -> Contract-clearStorage c = c { storage = clear c.storage }+clearStorage c = c { storage = clear c.storage, tStorage = clear c.tStorage }   where     clear :: Expr Storage -> Expr Storage     clear (ConcreteStore _) = ConcreteStore mempty@@ -324,7 +358,11 @@     baseFee    <- fmap read <$> v' .:? "baseFeePerGas"     timestamp  <- wordField v' "timestamp"     mixHash    <- wordField v' "mixHash"-    pure $ Block coinbase difficulty mixHash gasLimit (fromMaybe 0 baseFee) number timestamp txs+    beaconRoot <- fmap read <$> v' .:? "parentBeaconBlockRoot"+    pure $ Block { coinbase, difficulty, mixHash, gasLimit+                 , baseFee = fromMaybe 0 baseFee, number, timestamp+                 , txs, beaconRoot = fromMaybe 0 beaconRoot+                 }   parseJSON invalid =     JSON.typeMismatch "Block" invalid @@ -334,7 +372,7 @@           Pre  -> "pre"           Post -> "postState" -parseBCSuite :: Lazy.ByteString -> Either String (Map String Case)+parseBCSuite :: Lazy.ByteString-> Either String (Map String Case) parseBCSuite x = case (JSON.eitherDecode' x) :: Either String (Map String BlockchainCase) of   Left e        -> Left e   Right bcCases -> let allCases = fromBlockchainCase <$> bcCases@@ -343,10 +381,10 @@                        filteredCases = Map.filter keepError allCases                        (erroredCases, parsedCases) = splitEithers filteredCases     in if Map.size erroredCases > 0-    then Left ("errored case: " ++ (show erroredCases))-    else if Map.size parsedCases == 0-    then Left "No cases to check."-    else Right parsedCases+       then Left ("errored case: " ++ (show erroredCases))+       else if Map.size parsedCases == 0+            then Left "No cases to check."+            else Right parsedCases   data BlockchainError@@ -369,7 +407,7 @@ fromBlockchainCase :: BlockchainCase -> Either BlockchainError Case fromBlockchainCase (BlockchainCase blocks preState postState network) =   case (blocks, network) of-    ([block], "Shanghai") -> case block.txs of+    ([block], "Cancun") -> case block.txs of       [tx] -> fromBlockchainCase' block tx preState postState       []        -> Left NoTxs       _         -> Left TooManyTxs@@ -385,48 +423,50 @@ fromBlockchainCase' block tx preState postState =   let isCreate = isNothing tx.toAddr in   case (sender tx, checkTx tx block preState) of-      (Nothing, _) -> Left SignatureUnverified-      (_, Nothing) -> Left (if isCreate then FailedCreate else InvalidTx)-      (Just origin, Just checkState) -> Right $ Case-        (VMOpts-         { contract       = EVM.initialContract theCode-         , otherContracts = []-         , calldata       = (cd, [])-         , value          = Lit tx.value-         , address        = toAddr-         , caller         = LitAddr origin-         , baseState      = EmptyBase-         , origin         = LitAddr origin-         , gas            = tx.gasLimit - txGasCost feeSchedule tx-         , baseFee        = block.baseFee-         , priorityFee    = priorityFee tx block.baseFee-         , gaslimit       = tx.gasLimit-         , number         = block.number-         , timestamp      = Lit block.timestamp-         , coinbase       = LitAddr block.coinbase-         , prevRandao     = block.mixHash-         , maxCodeSize    = maxCodeSize-         , blockGaslimit  = block.gasLimit-         , gasprice       = effectiveGasPrice-         , schedule       = feeSchedule-         , chainId        = 1-         , create         = isCreate-         , txAccessList   = Map.mapKeys LitAddr (txAccessMap tx)-         , allowFFI       = False-         })-        checkState-        postState-          where-            toAddr = maybe (EVM.createAddress origin (fromJust senderNonce)) LitAddr (tx.toAddr)-            senderNonce = view (accountAt (LitAddr origin) % #nonce) (Map.mapKeys LitAddr preState)-            toCode = Map.lookup toAddr (Map.mapKeys LitAddr preState)-            theCode = if isCreate-                      then InitCode tx.txdata mempty-                      else maybe (RuntimeCode (ConcreteRuntimeCode "")) (view #code) toCode-            effectiveGasPrice = effectiveprice tx block.baseFee-            cd = if isCreate-                 then mempty-                 else ConcreteBuf tx.txdata+    (Nothing, _) -> Left SignatureUnverified+    (_, Nothing) -> Left (if isCreate then FailedCreate else InvalidTx)+    (Just origin, Just checkState) -> Right $ Case+      (VMOpts+       { contract       = EVM.initialContract theCode+       , otherContracts = []+       , calldata       = (cd, [])+       , value          = Lit tx.value+       , address        = toAddr+       , caller         = LitAddr origin+       , baseState      = EmptyBase+       , origin         = LitAddr origin+       , gas            = tx.gasLimit - txGasCost feeSchedule tx+       , baseFee        = block.baseFee+       , priorityFee    = priorityFee tx block.baseFee+       , gaslimit       = tx.gasLimit+       , number         = block.number+       , timestamp      = Lit block.timestamp+       , coinbase       = LitAddr block.coinbase+       , prevRandao     = block.mixHash+       , maxCodeSize    = maxCodeSize+       , blockGaslimit  = block.gasLimit+       , gasprice       = effectiveGasPrice+       , schedule       = feeSchedule+       , chainId        = 1+       , create         = isCreate+       , txAccessList   = Map.mapKeys LitAddr (txAccessMap tx)+       , allowFFI       = False+       , freshAddresses = 0+       , beaconRoot     = block.beaconRoot+       })+      checkState+      postState+        where+          toAddr = maybe (EVM.createAddress origin (fromJust senderNonce)) LitAddr (tx.toAddr)+          senderNonce = view (accountAt (LitAddr origin) % #nonce) (Map.mapKeys LitAddr preState)+          toCode = Map.lookup toAddr (Map.mapKeys LitAddr preState)+          theCode = if isCreate+                    then InitCode tx.txdata mempty+                    else maybe (RuntimeCode (ConcreteRuntimeCode "")) (.code) toCode+          effectiveGasPrice = effectiveprice tx block.baseFee+          cd = if isCreate+               then mempty+               else ConcreteBuf tx.txdata  effectiveprice :: Transaction -> W256 -> W256 effectiveprice tx baseFee = priorityFee tx baseFee + baseFee@@ -449,17 +489,6 @@      EIP1559Transaction -> fromJust tx.maxFeePerGas      _ -> fromJust tx.gasPrice -validateTx :: Transaction -> Block -> Map Addr Contract -> Maybe ()-validateTx tx block cs = do-  origin        <- sender tx-  (Lit originBalance) <- (view #balance) <$> view (at origin) cs-  originNonce   <- (view #nonce)   <$> view (at origin) cs-  let gasDeposit = (effectiveprice tx block.baseFee) * (into tx.gasLimit)-  if gasDeposit + tx.value <= originBalance-    && (Just (unsafeInto tx.nonce) == originNonce) && block.baseFee <= maxBaseFee tx-  then Just ()-  else Nothing- checkTx :: Transaction -> Block -> Map Addr Contract -> Maybe (Map Addr Contract) checkTx tx block prestate = do   origin <- sender tx@@ -481,10 +510,25 @@   else     pure prestate +validateTx :: Transaction -> Block -> Map Addr Contract -> Maybe ()+validateTx tx block cs = do+  origin <- sender tx+  Lit originBalance <- (.balance) <$> Map.lookup origin cs+  originNonce <- (.nonce) <$> Map.lookup origin cs+  let gasDeposit = (effectiveprice tx block.baseFee) * (into tx.gasLimit)+  if gasDeposit + tx.value <= originBalance+    && (Just (unsafeInto tx.nonce) == originNonce) && block.baseFee <= maxBaseFee tx+  then Just ()+  else Nothing+ vmForCase :: Case -> IO (VM Concrete RealWorld) vmForCase x = do   vm <- stToIO $ makeVm x.vmOpts+    -- TODO: why do we override contracts here instead of using VMOpts otherContracts?     <&> set (#env % #contracts) (Map.mapKeys LitAddr x.checkContracts)+    -- TODO: we need to call this again because we override contracts in the+    -- previous line+    <&> setEIP4788Storage x.vmOpts   pure $ initTx vm  forceConcreteAddrs :: Map (Expr EAddr) Contract -> Map Addr Contract

test/EVM/Test/Tracing.hs view

@@ -23,7 +23,7 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as Char8-import Data.Maybe (fromJust, isJust, isNothing)+import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) import Data.Map.Strict qualified as Map import Data.Text.IO qualified as T import Data.Vector qualified as Vector@@ -33,12 +33,13 @@ import Numeric (showHex) import Paths_hevm qualified as Paths import System.Directory (removeFile)+import System.Environment (lookupEnv) import System.Process (readProcessWithExitCode) import Test.QuickCheck (elements) import Test.QuickCheck.Instances.Text() import Test.QuickCheck.Instances.Natural() import Test.QuickCheck.Instances.ByteString()-import Test.Tasty (testGroup, TestTree, TestName)+import Test.Tasty (testGroup, after, TestTree, TestName, DependencyType(..)) import Test.Tasty.HUnit (assertEqual, testCase) import Test.Tasty.QuickCheck hiding (Failure, Success) import Witch (into, unsafeInto)@@ -144,22 +145,26 @@   { coinbase    :: Addr   , timestamp   :: Expr EWord   , number      :: W256-  , prevRandao  :: W256   , gasLimit    :: Data.Word.Word64   , baseFee     :: W256   , maxCodeSize :: W256   , schedule    :: FeeSchedule Data.Word.Word64   , blockHashes :: Map.Map Int W256+  , withdrawals :: [Addr]+  , currentRandom :: W256+  , parentBeaconBlockRoot :: W256   } deriving (Show, Generic)  instance JSON.ToJSON EVMToolEnv where-  toJSON b = JSON.object [ ("currentCoinBase"  , (JSON.toJSON $ b.coinbase))-                         , ("currentDifficulty", (JSON.toJSON $ b.prevRandao))+  toJSON b = JSON.object [ ("currentCoinBase"  , (JSON.toJSON b.coinbase))                          , ("currentGasLimit"  , (JSON.toJSON ("0x" ++ showHex (into @Integer b.gasLimit) "")))-                         , ("currentNumber"    , (JSON.toJSON $ b.number))+                         , ("currentNumber"    , (JSON.toJSON b.number))                          , ("currentTimestamp" , (JSON.toJSON tstamp))-                         , ("currentBaseFee"   , (JSON.toJSON $ b.baseFee))-                         , ("blockHashes"      , (JSON.toJSON $ b.blockHashes))+                         , ("currentBaseFee"   , (JSON.toJSON b.baseFee))+                         , ("blockHashes"      , (JSON.toJSON b.blockHashes))+                         , ("withdrawals"      , (JSON.toJSON b.withdrawals))+                         , ("currentRandom"    , (JSON.toJSON b.currentRandom))+                         , ("parentBeaconBlockRoot" , (JSON.toJSON b.parentBeaconBlockRoot))                          ]               where                 tstamp :: W256@@ -171,12 +176,14 @@ emptyEvmToolEnv = EVMToolEnv { coinbase = 0                              , timestamp = Lit 0                              , number     = 0-                             , prevRandao = 42069                              , gasLimit   = 0xffffffffffffffff                              , baseFee    = 0                              , maxCodeSize= 0xffffffff                              , schedule   = feeSchedule                              , blockHashes = mempty+                             , withdrawals = mempty+                             , currentRandom = 42+                             , parentBeaconBlockRoot = 5                              }  data EVMToolReceipt =@@ -190,6 +197,7 @@     , transactionHash :: String     , contractAddress :: String     , gasUsed :: String+    , effectiveGasPrice :: Maybe String     , blockHash :: String     , transactionIndex :: String     } deriving (Generic, Show)@@ -205,6 +213,7 @@         <*> v .: "transactionHash"         <*> v .: "contractAddress"         <*> v .: "gasUsed"+        <*> v .: "effectiveGasPrice"         <*> v .: "blockHash"         <*> v .: "transactionIndex" @@ -216,24 +225,15 @@   , logsHash :: String   , logsBloom :: String   , receipts :: [EVMToolReceipt]-  , currentDifficulty :: String+  , currentDifficulty :: Maybe String   , gasUsed :: String-  , rejected :: Maybe [EVMRejected]+  , currentBaseFee :: String+  , withdrawalsRoot :: String   } deriving (Generic, Show)  instance JSON.FromJSON EVMToolResult -data EVMRejected =-  EVMRejected-    { index :: Int-    , err :: String-    } deriving (Generic, Show) -instance JSON.FromJSON EVMRejected where-  parseJSON = JSON.withObject "EVMRejected" $ \v -> EVMRejected-    <$> v .: "index"-    <*> v .: "error"- data EVMToolAlloc =   EVMToolAlloc   { balance :: W256@@ -285,15 +285,17 @@       , maxFeePerGas = Just 1       , chainId = 1       }-    evmEnv = EVMToolEnv { coinbase   =  0xff-                        , timestamp   =  Lit 0x3e8-                        , number      =  0x0-                        , prevRandao  =  0x0-                        , gasLimit    =  unsafeInto gaslimitExec-                        , baseFee     =  0x0-                        , maxCodeSize =  0xfffff-                        , schedule    =  feeSchedule-                        , blockHashes =  blockHashesDefault+    evmEnv = EVMToolEnv { coinbase      = 0xff+                        , timestamp     = Lit 0x3e8+                        , number        = 0x0+                        , gasLimit      = unsafeInto gaslimitExec+                        , baseFee       = 0x0+                        , maxCodeSize   = 0xfffff+                        , schedule      = feeSchedule+                        , blockHashes   = blockHashesDefault+                        , withdrawals   = mempty+                        , currentRandom = 42+                        , parentBeaconBlockRoot = 5                         }     sk = 0xDC38EE117CAE37750EB1ECC5CFD3DE8E85963B481B93E732C5D0CB66EE6B0C9D     fromAddress = fromJust $ deriveAddr sk@@ -320,7 +322,8 @@   JSON.encodeFile "alloc.json" alloc   JSON.encodeFile "env.json" evmEnv   (exitCode, evmtoolStdout, evmtoolStderr) <- readProcessWithExitCode "evm" [ "transition"-                               ,"--input.alloc" , "alloc.json"+                               , "--state.fork", "Cancun"+                               , "--input.alloc" , "alloc.json"                                , "--input.env" , "env.json"                                , "--input.txs" , "txs.json"                                , "--output.alloc" , "alloc-out.json"@@ -398,11 +401,24 @@     Nothing -> pure Nothing     Just res -> do       let traceFileName = getTraceFileName res+      decodeTraceOutputHelper traceFileName++decodeTraceOutputHelper :: String -> IO (Maybe EVMToolTraceOutput)+decodeTraceOutputHelper traceFileName = do       convertPath <- Paths.getDataFileName "test/scripts/convert_trace_to_json.sh"-      (exitcode, _, _) <- readProcessWithExitCode "bash" [convertPath, getTraceFileName res] ""+      maybeShellPath <- (fromMaybe "bash") <$> (lookupEnv "HEVM_SYSTEM_SHELL")+      let shellPath = if maybeShellPath == "" then "bash" else maybeShellPath+      (exitcode, stdout, stderr) <- readProcessWithExitCode shellPath [convertPath, traceFileName] ""       case exitcode of-        ExitSuccess -> JSON.decodeFileStrict (traceFileName ++ ".json") :: IO (Maybe EVMToolTraceOutput)-        _ -> pure Nothing+        ExitSuccess -> do+          -- putStrLn $ "Successfully converted trace to JSON: " <> (show stdout) <> " " <>+          --   (show stderr) <> " " <> (show exitcode) <> " " <> (show traceFileName)+          JSON.decodeFileStrict (traceFileName ++ ".json") :: IO (Maybe EVMToolTraceOutput)+        _ -> do+          putStrLn $ "Error converting trace! exit code:" <> (show exitcode)+          putStrLn $ "stdout: " <> (show stdout)+          putStrLn $ "stderr: " <> (show stderr)+          pure Nothing  deleteTraceOutputFiles :: Maybe EVMToolResult -> IO () deleteTraceOutputFiles evmtoolResult =@@ -419,7 +435,7 @@   :: App m   => Fetch.RpcInfo -> EVMToolEnv -> EVMToolAlloc -> EVM.Transaction.Transaction   -> Expr EAddr -> Expr EAddr -> m (Either (EvmError, [VMTrace]) ((Expr 'End, [VMTrace], VMTraceResult)))-runCodeWithTrace rpcinfo evmEnv alloc txn fromAddr toAddress = withSolvers Z3 0 Nothing $ \solvers -> do+runCodeWithTrace rpcinfo evmEnv alloc txn fromAddr toAddress = withSolvers Z3 0 1 Nothing $ \solvers -> do   let calldata' = ConcreteBuf txn.txdata       code' = alloc.code       buildExpr s vm = interpret (Fetch.oracle s Nothing) Nothing 1 Naive vm runExpr@@ -451,7 +467,7 @@     , gas = txn.gasLimit - (EVM.Transaction.txGasCost evmToolEnv.schedule txn)     , gaslimit = txn.gasLimit     , blockGaslimit = evmToolEnv.gasLimit-    , prevRandao = evmToolEnv.prevRandao+    , prevRandao = evmToolEnv.currentRandom     , baseFee = evmToolEnv.baseFee     , priorityFee = fromJust txn.maxPriorityFeeGas     , maxCodeSize = evmToolEnv.maxCodeSize@@ -460,12 +476,14 @@     , create = False     , txAccessList = mempty     , allowFFI = False+    , freshAddresses = 0+    , beaconRoot = 0     }) <&> set (#env % #contracts % at (LitAddr ethrunAddress))              (Just (initialContract (RuntimeCode (ConcreteRuntimeCode BS.empty))))        <&> set (#state % #calldata) calldata'  runCode :: App m => Fetch.RpcInfo -> ByteString -> Expr Buf -> m (Maybe (Expr Buf))-runCode rpcinfo code' calldata' = withSolvers Z3 0 Nothing $ \solvers -> do+runCode rpcinfo code' calldata' = withSolvers Z3 0 1 Nothing $ \solvers -> do   origVM <- liftIO $ stToIO $ vmForRuntimeCode               code'               calldata'@@ -495,26 +513,7 @@              }   where     readoutError :: Maybe (VMResult t s) -> Maybe String-    readoutError (Just (VMFailure e)) = case e of-      -- NOTE: error text made to closely match go-ethereum's errors.go file-      OutOfGas {}             -> Just "out of gas"-      -- TODO "contract creation code storage out of gas" not handled-      CallDepthLimitReached   -> Just "max call depth exceeded"-      BalanceTooLow {}        -> Just "insufficient balance for transfer"-      -- TODO "contract address collision" not handled-      Revert {}           -> Just "execution reverted"-      -- TODO "max initcode size exceeded" not handled-      MaxCodeSizeExceeded {}  -> Just "max code size exceeded"-      BadJumpDestination  -> Just "invalid jump destination"-      StateChangeWhileStatic  -> Just "write protection"-      ReturnDataOutOfBounds   -> Just "return data out of bounds"-      IllegalOverflow     -> Just "gas uint64 overflow"-      UnrecognizedOpcode op   -> Just $ "invalid opcode: " <> show op-      NonceOverflow       -> Just "nonce uint64 overflow"-      StackUnderrun       -> Just "stack underflow"-      StackLimitExceeded  -> Just "stack limit reached"-      InvalidMemoryAccess -> Just "write protection"-      err                     -> Just $ "HEVM error: " <> show err+    readoutError (Just (VMFailure e)) = Just $ evmErrToString e     readoutError _ = Nothing  vmres :: VM Concrete s -> VMTraceResult@@ -751,7 +750,8 @@       ])       -- memory manip       , (1200, frequency [-          (50, pure OpMload)+          (10, pure OpMcopy)+        , (50, pure OpMload)         , (1, pure OpMstore)         , (300, pure OpMstore8)       ])@@ -759,6 +759,8 @@       , (100, frequency [           (1, pure OpSload)         , (1, pure OpSstore)+        , (1, pure OpTstore)+        , (1, pure OpTload)       ])       -- Jumping around       , (50, frequency [@@ -834,21 +836,21 @@         --       It should work also when we external calls. Removing for now.         contrFixed <- liftIO $ fixContractJumps $ removeExtcalls contr         checkTraceAndOutputs contrFixed gasLimit txData-      , test "calldata-wraparound" $ do+      , after AllFinish "random-contract-concrete-call" $ test "calldata-wraparound-1" $ do         let contract = OpContract $ concat               [ [OpPush (Lit 0xff),OpPush (Lit 31),OpMstore8] -- value, offs               , [OpPush (Lit 0x3),OpPush (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff),OpPush (Lit 0x0),OpCalldatacopy] -- size, offs, destOffs               , [OpPush (Lit 0x20),OpPush (Lit 0),OpReturn] -- datasize, offs               ]         checkTraceAndOutputs contract 40000 (BS.pack [1, 2, 3, 4, 5])-      , test "calldata-wraparound2" $ do+      , after AllFinish "calldata-wraparound-1" $ test "calldata-wraparound-2" $ do         let contract = OpContract $ concat               [ [OpPush (Lit 0xff),OpPush (Lit 0),OpMstore8] -- value, offs               , [OpPush (Lit 0x10),OpPush (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff),OpPush (Lit 0x0),OpCalldatacopy] -- size, offs, destOffs               , [OpPush (Lit 0x20),OpPush (Lit 0),OpReturn] -- datasize, offs               ]         checkTraceAndOutputs contract 40000 (BS.pack [1, 2, 3, 4, 5])-      , test "calldata-overwrite-with-0-if-oversized" $ do+      , after AllFinish "calldata-wraparound-2" $ test "calldata-overwrite-with-0-if-oversized" $ do         -- supposed to copy 1...6 and then 0s, overwriting the 0xff with 0         let contract = OpContract $ concat               [ [OpPush (Lit 0xff),OpPush (Lit 1),OpMstore8] -- value, offs@@ -856,14 +858,14 @@               , [OpPush (Lit 10),OpPush (Lit 0x0),OpReturn] -- datasize, offset               ]         checkTraceAndOutputs contract 40000 (BS.pack [1, 2, 3, 4, 5, 6])-      , test "calldata-overwrite-correct-size" $ do+      , after AllFinish "calldata-overwrite-with-0-if-oversized" $ test "calldata-overwrite-correct-size" $ do         let contract = OpContract $ concat               [ [OpPush (Lit 0xff),OpPush (Lit 8),OpMstore8] -- value, offs               , [OpPush (Lit 10),OpPush (Lit 0),OpPush (Lit 0), OpCalldatacopy] -- size, offs, destOffs               , [OpPush (Lit 10),OpPush (Lit 0x0),OpReturn] -- datasize, offset               ]         checkTraceAndOutputs contract 40000 (BS.pack [1, 2, 3, 4, 5, 6])-      , test "calldata-offset-copy" $ do+      , after AllFinish "calldata-overwrite-correct-size" $ test "calldata-offset-copy" $ do         let contract = OpContract $ concat               [ [OpPush (Lit 0xff),OpPush (Lit 8),OpMstore8] -- value, offs               , [OpPush (Lit 0xff),OpPush (Lit 1),OpMstore8] -- value, offs

test/EVM/Test/Utils.hs view

@@ -1,18 +1,15 @@-{-# LANGUAGE QuasiQuotes #-}- module EVM.Test.Utils where -import Data.String.Here import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.IO qualified as T-import GHC.IO.Handle (hClose)+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)@@ -32,10 +29,13 @@   => 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-      Left e -> error e+    (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 Z3 1 timeout $ \solvers -> do+        withSolvers Z3 1 1 timeout $ \solvers -> do           opts <- liftIO $ testOpts solvers root (Just bo) match maxIter ffiAllowed rpcinfo           unitTest opts contracts @@ -62,26 +62,34 @@     , testParams = params     , dapp = srcInfo     , ffiAllowed = allowFFI+    , checkFailBit = False     } -compile :: ProjectType -> FilePath -> FilePath -> IO (Either String BuildOutput)-compile DappTools root src = do-  json <- compileWithDSTest src-  createDirectory (root <> "/out")-  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"-  case foundryType of-    FoundryStdLib -> initStdForgeDir (root <> "/lib/forge-std")-    Foundry -> pure ()-  r@(res,_,_) <- readProcessWithExitCode "forge" ["build", "--root", root] ""+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: " <> show r+    ExitFailure _ -> pure . Left $ "compilation failed: " <> "exit code: " <> show res <> "\n\nstdout:\n" <> out <> "\n\nstderr:\n" <> err     ExitSuccess -> readBuildOutput root Foundry   where     initStdForgeDir :: FilePath -> IO ()@@ -89,74 +97,14 @@       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"]-      callProcess "cp" ["-r", forgeStdRepo <> "/lib", tld <> "/lib"]+      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+      createDirectoryIfMissing True (tld </> "src")+      writeFile (tld </> "src" </> dstFile) =<< readFile =<< Paths.getDataFileName srcFile       _ <- readProcessWithExitCode "git" ["init", tld] ""-      callProcess "git" ["config", "--file", tld <> "/.git/config", "user.name", "'hevm'"]-      callProcess "git" ["config", "--file", tld <> "/.git/config", "user.email", "'hevm@hevm.dev'"]-      callProcess "git" ["--git-dir", tld <> "/.git", "--work-tree", tld, "add", tld]-      _ <- readProcessWithExitCode "git" ["--git-dir", tld <> "/.git", "--work-tree", tld, "--no-gpg-sign", "commit", "-m"] ""+      callProcess "git" ["config", "--file", tld </> ".git" </> "config", "user.name", "'hevm'"]+      callProcess "git" ["config", "--file", tld </> ".git" </> "config", "user.email", "'hevm@hevm.dev'"]+      callProcessCwd "git" ["add", "."] tld+      callProcessCwd "git" ["commit", "-m", "", "--allow-empty-message", "--no-gpg-sign"] tld       pure ()---- We don't want to depend on dapptools here, so we cheat and just call solc with the same options that dapp itself uses-compileWithDSTest :: FilePath -> IO Text-compileWithDSTest src =-  withSystemTempFile "input.json" $ \file handle -> do-    hClose handle-    dsTest <- readFile =<< Paths.getDataFileName "test/contracts/lib/test.sol"-    erc20 <- readFile =<< Paths.getDataFileName "test/contracts/lib/erc20.sol"-    testFilePath <- Paths.getDataFileName src-    testFile <- readFile testFilePath-    T.writeFile file-      [i|-      {-        "language": "Solidity",-        "sources": {-          "ds-test/test.sol": {-            "content": ${dsTest}-          },-          "tokens/erc20.sol": {-            "content": ${erc20}-          },-          "unit-tests.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"-              ]-            }-          }-        }-      }-      |]-    x <- T.pack <$>-      readProcess-        "solc"-        ["--allow-paths", file, "--standard-json", file]-        ""-    return x-

test/rpc.hs view

@@ -82,7 +82,7 @@           wad = 0x999999999999999999           calldata' = ConcreteBuf $ abiMethod "transfer(address,uint256)" (AbiTuple (V.fromList [AbiAddress (Addr 0xdead), AbiUInt 256 wad]))         vm <- liftIO $ weth9VM blockNum (calldata', [])-        postVm <- withSolvers Z3 1 Nothing $ \solvers ->+        postVm <- withSolvers Z3 1 1 Nothing $ \solvers ->           Stepper.interpret (oracle solvers (Just (BlockNumber blockNum, testRpc))) vm Stepper.runFully         let           wethStore = (fromJust $ Map.lookup (LitAddr 0xC02aaA39b223FE8D0A0e5C4F27eAD9083C756Cc2) postVm.env.contracts).storage@@ -106,7 +106,7 @@           postc _ (Failure _ _ (Revert _)) = PBool False           postc _ _ = PBool True         vm <- liftIO $ weth9VM blockNum calldata'-        (_, [Cex (_, model)]) <- withSolvers Z3 1 Nothing $ \solvers ->+        (_, [Cex (_, model)]) <- withSolvers Z3 1 1 Nothing $ \solvers ->           verify solvers (rpcVeriOpts (BlockNumber blockNum, testRpc)) (symbolify vm) (Just postc)         liftIO $ assertBool "model should exceed caller balance" (getVar model "arg2" >= 695836005599316055372648)     ]@@ -156,6 +156,8 @@     , baseState      = EmptyBase     , txAccessList   = mempty     , allowFFI       = False+    , freshAddresses = 0+    , beaconRoot     = 0     }) <&> set (#cache % #fetched % at address) (Just ctrct)  testRpc :: Text

test/test.hs view

@@ -7,6 +7,7 @@  import GHC.TypeLits import Data.Proxy+import Control.Monad import Control.Monad.ST (RealWorld, stToIO) import Control.Monad.State.Strict import Control.Monad.IO.Unlift@@ -20,7 +21,6 @@ import Data.DoubleWord import Data.Either import Data.List qualified as List-import Data.List.Utils as DLU import Data.Map.Strict qualified as Map import Data.Maybe import Data.String.Here@@ -28,9 +28,11 @@ import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Time (diffUTCTime, getCurrentTime)+import Data.Tuple.Extra+import Data.Tree (flatten) import Data.Typeable import Data.Vector qualified as V-import Data.Word (Word8)+import Data.Word (Word8, Word64) import GHC.Conc (getNumProcessors) import System.Directory import System.Environment@@ -69,6 +71,7 @@ import EVM.Traversals import EVM.Types hiding (Env) import EVM.Effects+import EVM.UnitTest (writeTrace)  testEnv :: Env testEnv = Env { config = defaultConfig {@@ -76,9 +79,8 @@   , dumpExprs = False   , dumpEndStates = False   , debug = False-  , abstRefineArith = False-  , abstRefineMem   = False   , dumpTrace = False+  , decomposeStorage = True   } }  putStrLnM :: (MonadUnliftIO m) => String -> m ()@@ -101,6 +103,12 @@ prop :: Testable prop => ReaderT Env IO prop -> Property prop a = ioProperty $ runEnv testEnv a +withDefaultSolver :: App m => (SolverGroup -> m a) -> m a+withDefaultSolver = withSolvers Z3 1 1 Nothing++withCVC5Solver :: App m => (SolverGroup -> m a) -> m a+withCVC5Solver = withSolvers CVC5 1 1 Nothing+ main :: IO () main = defaultMain tests @@ -127,7 +135,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     -- This case is somewhat artificial. We can't simplify this using only     -- static rewrite rules, because acct is totally abstract and acct + 1@@ -147,7 +155,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        -- T.writeFile "symbolic-index.expr" $ formatExpr expr        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     , expectFail $ test "simplify-storage-array-of-struct-symbolic-index" $ do@@ -168,7 +176,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     , test "simplify-storage-array-loop-nonstruct" $ do        Just c <- solcRuntime "MyContract"@@ -183,8 +191,53 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256)" [AbiUIntType 256])) [] (defaultVeriOpts { maxIter = Just 5 })+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256)" [AbiUIntType 256])) [] (defaultVeriOpts { maxIter = Just 5 })        assertEqualM "Expression is not clean." (badStoresInExpr expr) False+    , test "simplify-storage-map-newtest1" $ do+       Just c <- solcRuntime "MyContract"+        [i|+        contract MyContract {+          mapping (uint => uint) a;+          mapping (uint => uint) b;+          function fun(uint v, uint i) public {+            require(i < 1000);+            require(v < 1000);+            b[i+v] = v+1;+            a[i] = v;+            b[i+1] = v+1;+            assert(a[i] == v);+            assert(b[i+1] == v+1);+          }+        }+        |]+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       (_, [(Qed _)]) <- withDefaultSolver $ \s -> checkAssert s [0x11] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       liftIO $ putStrLn "OK"+    , ignoreTest $ test "simplify-storage-map-todo" $ do+       Just c <- solcRuntime "MyContract"+        [i|+        contract MyContract {+          mapping (uint => uint) a;+          mapping (uint => uint) b;+          function fun(uint v, uint i) public {+            require(i < 1000);+            require(v < 1000);+            a[i] = v;+            b[i+1] = v+1;+            b[i+v] = 55; // note: this can overwrite b[i+1], hence assert below can fail+            assert(a[i] == v);+            assert(b[i+1] == v+1);+          }+        }+        |]+       -- TODO: expression below contains (load idx1 (store idx1 (store idx1 (store idx0)))), and the idx0+       --       is not stripped. This is due to us not doing all we can in this case, see+       --       note above readStorage. Decompose remedies this (when it can be decomposed)+       -- expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       -- putStrLnM $ T.unpack $ formatExpr expr+       (_, [Cex _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       liftIO $ putStrLn "OK"     , test "simplify-storage-array-loop-struct" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -203,7 +256,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] (defaultVeriOpts { maxIter = Just 5 })+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] (defaultVeriOpts { maxIter = Just 5 })        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     , test "decompose-1" $ do       Just c <- solcRuntime "MyContract"@@ -218,7 +271,8 @@           }         }         |]-      expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "prove_mapping_access(address,address)" [AbiAddressType, AbiAddressType])) [] defaultVeriOpts+      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mapping_access(address,address)" [AbiAddressType, AbiAddressType])) [] defaultVeriOpts+      putStrLnM $ T.unpack $ formatExpr expr       let simpExpr = mapExprM Expr.decomposeStorage expr       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)       assertEqualM "Decompose did not succeed." (isJust simpExpr) True@@ -234,14 +288,11 @@           }         }         |]-      expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "prove_mixed_symoblic_concrete_writes(address,uint256)" [AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts+      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed_symoblic_concrete_writes(address,uint256)" [AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts       let simpExpr = mapExprM Expr.decomposeStorage expr       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)       assertEqualM "Decompose did not succeed." (isJust simpExpr) True-    -- NOTE: we can't do the rewrite below, because x could be very large,-    -- which would allow us to overwrite *anything in the storage*, and that throws-    -- everything off.-    , expectFail $ test "decompose-3" $ do+    , test "decompose-3" $ do       Just c <- solcRuntime "MyContract"         [i|         contract MyContract {@@ -254,9 +305,8 @@           }         }         |]-      expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts       let simpExpr = mapExprM Expr.decomposeStorage expr-      -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)       assertEqualM "Decompose did not succeed." (isJust simpExpr) True     , test "decompose-4-mixed" $ do       Just c <- solcRuntime "MyContract"@@ -273,7 +323,7 @@           }         }         |]-      expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts       let simpExpr = mapExprM Expr.decomposeStorage expr       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)       assertEqualM "Decompose did not succeed." (isJust simpExpr) True@@ -300,7 +350,7 @@           }         }         |]-      expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "prove_mixed(address,address,uint256)" [AbiAddressType, AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts+      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed(address,address,uint256)" [AbiAddressType, AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts       let simpExpr = mapExprM Expr.decomposeStorage expr       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)       assertEqualM "Decompose did not succeed." (isJust simpExpr) True@@ -317,7 +367,7 @@           }         }         |]-      expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "prove_mixed(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed(uint256)" [AbiUIntType 256])) [] defaultVeriOpts       let simpExpr = mapExprM Expr.decomposeStorage expr       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)       assertEqualM "Decompose did not succeed." (isJust simpExpr) True@@ -335,7 +385,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     , test "simplify-storage-map-only-2" $ do        Just c <- solcRuntime "MyContract"@@ -351,7 +401,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        -- putStrLnM $ T.unpack $ formatExpr expr        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     , test "simplify-storage-map-with-struct" $ do@@ -372,7 +422,7 @@           }         }         |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     , test "simplify-storage-map-and-array" $ do        Just c <- solcRuntime "MyContract"@@ -394,7 +444,7 @@           }         }        |]-       expr <- withSolvers Z3 1 Nothing $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        -- putStrLnM $ T.unpack $ formatExpr expr        assertEqualM "Expression is not clean." (badStoresInExpr expr) False     ]@@ -437,6 +487,14 @@         let e = ReadByte (Lit 0x0) (WriteWord (Lit 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffd) (Lit 0x0) (ConcreteBuf "\255\255\255\255"))         b <- checkEquiv e (Expr.simplify e)         assertBoolM "Simplifier failed" b+    , test "buffer-length-copy-slice-beyond-source1" $ do+        let e = BufLength (CopySlice (Lit 0x2) (Lit 0x2) (Lit 0x1) (ConcreteBuf "a") (ConcreteBuf ""))+        b <- checkEquiv e (Expr.simplify e)+        assertBoolM "Simplifier failed" b+    , test "buffer-length-copy-slice-beyond-source2" $ do+        let e = BufLength (CopySlice (Lit 0x2) (Lit 0x2) (Lit 0x1) (ConcreteBuf "") (ConcreteBuf ""))+        b <- checkEquiv e (Expr.simplify e)+        assertBoolM "Simplifier failed" b     , test "simp-max-buflength" $ do       let simp = Expr.simplify $ Max (Lit 0) (BufLength (AbstractBuf "txdata"))       assertEqualM "max-buflength rules" simp $ BufLength (AbstractBuf "txdata")@@ -473,6 +531,12 @@     , test "simp-assoc-mul2" $ do       let simp = Expr.simplify       $  Mul (Lit 2) (Mul (Var "a") (Lit 3))       assertEqualM "assoc rules" simp $ Mul (Lit 6) (Var "a")+    , test "simp-zero-write-extend-buffer-len" $ do+        let+          expr = BufLength $ CopySlice (Lit 0) (Lit 0x10) (Lit 0) (AbstractBuf "buffer") (ConcreteBuf "bimm")+          simp = Expr.simplify expr+        ret <-  checkEquiv expr simp+        assertEqualM "Must be equivalent" True ret     , test "bufLength-simp" $ do       let         a = BufLength (ConcreteBuf "ab")@@ -491,21 +555,30 @@           b = Expr.simplify a         ret <- checkEquiv a b         assertBoolM "must be equivalent" ret+    , test "read-beyond-bound (negative-test)" $ do+      let+        e1 = CopySlice (Lit 1) (Lit 0) (Lit 2) (ConcreteBuf "a") (ConcreteBuf "")+        e2 = ConcreteBuf "Definitely not the same!"+      equal <- checkEquiv e1 e2+      assertBoolM "Should not be equivalent!" $ not equal     ]   -- These tests fuzz the simplifier by generating a random expression,   -- applying some simplification rules, and then using the smt encoding to   -- check that the simplified version is semantically equivalent to the   -- unsimplified one-  , adjustOption (\(Test.Tasty.QuickCheck.QuickCheckTests n) -> Test.Tasty.QuickCheck.QuickCheckTests (min n 50)) $ testGroup "SimplifierTests"+  , adjustOption (\(Test.Tasty.QuickCheck.QuickCheckTests n) -> Test.Tasty.QuickCheck.QuickCheckTests (div n 2)) $ testGroup "SimplifierTests"     [ testProperty  "buffer-simplification" $ \(expr :: Expr Buf) -> prop $ do         let simplified = Expr.simplify expr-        checkEquiv expr simplified+        checkEquivAndLHS expr simplified+    , testProperty  "buffer-simplification-len" $ \(expr :: Expr Buf) -> prop $ do+        let simplified = Expr.simplify (BufLength expr)+        checkEquivAndLHS (BufLength expr) simplified     , testProperty "store-simplification" $ \(expr :: Expr Storage) -> prop $ do         let simplified = Expr.simplify expr-        checkEquiv expr simplified+        checkEquivAndLHS expr simplified     , testProperty "load-simplification" $ \(GenWriteStorageLoad expr) -> prop $ do         let simplified = Expr.simplify expr-        checkEquiv expr simplified+        checkEquivAndLHS expr simplified     , ignoreTest $ testProperty "load-decompose" $ \(GenWriteStorageLoad expr) -> prop $ do         putStrLnM $ T.unpack $ formatExpr expr         let simp = Expr.simplify expr@@ -516,49 +589,49 @@         checkEquiv expr decomposed     , testProperty "byte-simplification" $ \(expr :: Expr Byte) -> prop $ do         let simplified = Expr.simplify expr-        checkEquiv expr simplified+        checkEquivAndLHS expr simplified     , testProperty "word-simplification" $ \(ZeroDepthWord expr) -> prop $ do         let simplified = Expr.simplify expr-        checkEquiv expr simplified+        checkEquivAndLHS expr simplified     , testProperty "readStorage-equivalance" $ \(store, slot) -> prop $ do         let simplified = Expr.readStorage' slot store             full = SLoad slot store-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "writeStorage-equivalance" $ \(val, GenWriteStorageExpr (slot, store)) -> prop $ do         let simplified = Expr.writeStorage slot val store             full = SStore slot val store-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "readWord-equivalance" $ \(buf, idx) -> prop $ do         let simplified = Expr.readWord idx buf             full = ReadWord idx buf-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "writeWord-equivalance" $ \(idx, val, WriteWordBuf buf) -> prop $ do         let simplified = Expr.writeWord idx val buf             full = WriteWord idx val buf-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "arith-simplification" $ \(_ :: Int) -> prop $ do         expr <- liftIO $ generate . sized $ genWordArith 15         let simplified = Expr.simplify expr-        checkEquiv expr simplified+        checkEquivAndLHS expr simplified     , testProperty "readByte-equivalance" $ \(buf, idx) -> prop $ do         let simplified = Expr.readByte idx buf             full = ReadByte idx buf-        checkEquiv simplified full+        checkEquiv full simplified     -- we currently only simplify concrete writes over concrete buffers so that's what we test here     , testProperty "writeByte-equivalance" $ \(LitOnly val, LitOnly buf, GenWriteByteIdx idx) -> prop $ do         let simplified = Expr.writeByte idx val buf             full = WriteByte idx val buf-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "copySlice-equivalance" $ \(srcOff, GenCopySliceBuf src, GenCopySliceBuf dst, LitWord @300 size) -> prop $ do         -- we bias buffers to be concrete more often than not         dstOff <- liftIO $ generate (maybeBoundedLit 100_000)         let simplified = Expr.copySlice srcOff dstOff size src dst             full = CopySlice srcOff dstOff size src dst-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "indexWord-equivalence" $ \(src, LitWord @50 idx) -> prop $ do         let simplified = Expr.indexWord idx src             full = IndexWord idx src-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "indexWord-mask-equivalence" $ \(src :: Expr EWord, LitWord @35 idx) -> prop $ do         mask <- liftIO $ generate $ do           pow <- arbitrary :: Gen Int@@ -570,7 +643,7 @@           input = And mask src           simplified = Expr.indexWord idx input           full = IndexWord idx input-        checkEquiv simplified full+        checkEquiv full simplified     , testProperty "toList-equivalance" $ \buf -> prop $ do         let           -- transforms the input buffer to give it a known length@@ -608,13 +681,13 @@           _ -> liftIO $ assertFailure "must evaluate down to a literal bool"     , testProperty "simplifyProp-equivalence-sym" $ \(p) -> prop $ do         let simplified = Expr.simplifyProp p-        checkEquivProp simplified p+        checkEquivPropAndLHS p simplified     , testProperty "simpProp-equivalence-sym-Prop" $ \(ps :: [Prop]) -> prop $ do         let simplified = pand (Expr.simplifyProps ps)-        checkEquivProp simplified (pand ps)+        checkEquivPropAndLHS (pand ps) simplified     , testProperty "simpProp-equivalence-sym-LitProp" $ \(LitProp p) -> prop $ do         let simplified = pand (Expr.simplifyProps [p])-        checkEquivProp simplified p+        checkEquivPropAndLHS p simplified     , testProperty "storage-slot-simp-property" $ \(StorageExp s) -> prop $ do         -- we have to run `Expr.structureArraySlots` on the unsimplified system, or         -- we'd need some form of minimal simplifier for things to work out. As long as@@ -622,8 +695,86 @@         -- and quite minimal         let s2 = Expr.structureArraySlots s         let simplified = Expr.simplify s2-        checkEquiv simplified s2+        checkEquivAndLHS s2 simplified+    , test "storage-slot-single" $ do+        -- this tests that "" and "0"x32 is not equivalent in Keccak+        let x = SLoad (Add (Keccak (ConcreteBuf "")) (Lit 1)) (SStore (Keccak (ConcreteBuf "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL")) (Lit 0) (AbstractStore (SymAddr "stuff") Nothing))+        let simplified = Expr.simplify x+        y <- checkEquivAndLHS x simplified+        assertBoolM "Must be equal" y+    , test "word-eq-bug" $ do+        -- This test is actually OK because the simplified takes into account that it's impossible to find a+        -- near-collision in the keccak hash+        let x =  (SLoad (Keccak (AbstractBuf "es")) (SStore (Add (Keccak (ConcreteBuf "")) (Lit 0x1)) (Lit 0xacab) (ConcreteStore (Map.empty))))+        let simplified = Expr.simplify x+        y <- checkEquiv x simplified+        assertBoolM "Must be equal, given keccak distance axiom" y     ]+  {- NOTE: These tests were designed to test behaviour on reading from a buffer such that the indices overflow 2^256.+           However, such scenarios are impossible in the real world (the operation would run out of gas). The problem+           is that the behaviour of bytecode interpreters does not match the semantics of SMT. Intrepreters just+           return all zeroes for any read beyond buffer size, while in SMT reading multiple bytes may lead to overflow+           on indices and subsequently to reading from the beginning of the buffer (wrap-around semantics).+  , testGroup "concrete-buffer-simplification-large-index" [+      test "copy-slice-large-index-nooverflow" $ do+        let+          e = CopySlice (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff) (Lit 0x0) (Lit 0x1) (ConcreteBuf "a") (ConcreteBuf "")+          s = Expr.simplify e+        equal <- checkEquiv e s+        assertEqualM "Must be equal" True equal+    , test "copy-slice-overflow-back-into-source" $ do+        let+          e = CopySlice (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff) (Lit 0x0) (Lit 0x2) (ConcreteBuf "a") (ConcreteBuf "")+          s = Expr.simplify e+        equal <- checkEquiv e s+        assertEqualM "Must be equal" True equal+    , test "copy-slice-overflow-beyond-source" $ do+        let+          e = CopySlice (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff) (Lit 0x0) (Lit 0x3) (ConcreteBuf "a") (ConcreteBuf "")+          s = Expr.simplify e+        equal <- checkEquiv e s+        assertEqualM "Must be equal" True equal+    , test "copy-slice-overflow-beyond-source-into-nonempty" $ do+        let+          e = CopySlice (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff) (Lit 0x0) (Lit 0x3) (ConcreteBuf "a") (ConcreteBuf "b")+          s = Expr.simplify e+        equal <- checkEquiv e s+        assertEqualM "Must be equal" True equal+    , test "read-word-overflow-back-into-source" $ do+        let+          e = ReadWord (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff) (ConcreteBuf "kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk")+          s = Expr.simplify e+        equal <- checkEquiv e s+        assertEqualM "Must be equal" True equal+  ]+  -}+  , testGroup "isUnsat-concrete-tests" [+      test "disjunction-left-false" $ do+        let+          t = [PEq (Var "x") (Lit 1), POr (PEq (Var "x") (Lit 0)) (PEq (Var "y") (Lit 1)), PEq (Var "y") (Lit 2)]+          cannotBeSat = Expr.isUnsat t+        assertEqualM "Must be equal" cannotBeSat True+    , test "disjunction-right-false" $ do+        let+          t = [PEq (Var "x") (Lit 1), POr (PEq (Var "y") (Lit 1)) (PEq (Var "x") (Lit 0)), PEq (Var "y") (Lit 2)]+          cannotBeSat = Expr.isUnsat t+        assertEqualM "Must be equal" cannotBeSat True+    , test "disjunction-both-false" $ do+        let+          t = [PEq (Var "x") (Lit 1), POr (PEq (Var "x") (Lit 2)) (PEq (Var "x") (Lit 0)), PEq (Var "y") (Lit 2)]+          cannotBeSat = Expr.isUnsat t+        assertEqualM "Must be equal" cannotBeSat True+    , ignoreTest $ test "disequality-and-equality" $ do+        let+          t = [PNeg (PEq (Lit 1) (Var "arg1")), PEq (Lit 1) (Var "arg1")]+          cannotBeSat = Expr.isUnsat t+        assertEqualM "Must be equal" cannotBeSat True+    , test "equality-and-disequality" $ do+        let+          t = [PEq (Lit 1) (Var "arg1"), PNeg (PEq (Lit 1) (Var "arg1"))]+          cannotBeSat = Expr.isUnsat t+        assertEqualM "Must be equal" cannotBeSat True+  ]   , testGroup "simpProp-concrete-tests" [       test "simpProp-concrete-trues" $ do         let@@ -666,12 +817,6 @@           t = [PEq (Lit 5) (Var "a"), POr (POr (PEq (Var "a") (Lit 4)) (PEq (Var "a") (Lit 6))) (PEq (Var "a") (Lit 3))]           simplified = Expr.simplifyProps t         assertEqualM "Must be equal" [PBool False] simplified-    , test "simpProp-concrete-or-eq-rem" $ do-        let-          -- a = 5 && ((a=4 || a=6) || a=3)  -> False-          t = [PEq (Lit 5) (Var "a"), POr (POr (PEq (Var "a") (Lit 4)) (PEq (Var "a") (Lit 6))) (PEq (Var "a") (Lit 3))]-          simplified = Expr.simplifyProps t-        assertEqualM "Must be equal" [PBool False] simplified     , test "simpProp-inner-expr-simp" $ do         let           -- 5+1 = 6@@ -684,6 +829,18 @@           t = [PAnd (PEq (Add (Lit 5) (Lit 1)) (Var "a")) (PEq (Var "a") (Lit 7))]           simplified = Expr.simplifyProps t         assertEqualM "Must be equal" [PBool False] simplified+    , test "simpProp-inner-expr-bitwise-and" $ do+        let+          -- 1 & 2 != 2+          t = [PEq (And (Lit 1) (Lit 2)) (Lit 2)]+          simplified = Expr.simplifyProps t+        assertEqualM "Must be equal" [PBool False] simplified+    , test "simpProp-inner-expr-bitwise-or" $ do+        let+          -- 2 | 4 == 6+          t = [PEq (Or (Lit 2) (Lit 4)) (Lit 6)]+          simplified = Expr.simplifyProps t+        assertEqualM "Must be equal" [] simplified   ]   , testGroup "MemoryTests"     [ test "read-write-same-byte"  $ assertEqualM ""@@ -744,9 +901,8 @@         (Expr.indexWord (Lit 2) (Lit 0xff22bb4455667788990011223344556677889900112233445566778899001122))     , test "encodeConcreteStore-overwrite" $       assertEqualM ""-        "(store (store ((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000) (_ bv1 256) (_ bv2 256)) (_ bv3 256) (_ bv4 256))"-        (EVM.SMT.encodeConcreteStore $-          Map.fromList [(W256 1, W256 2), (W256 3, W256 4)])+        (pure "(store (store ((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000) (_ bv1 256) (_ bv2 256)) (_ bv3 256) (_ bv4 256))")+        (EVM.SMT.encodeConcreteStore $ Map.fromList [(W256 1, W256 2), (W256 3, W256 4)])     , test "indexword-oob-sym" $ assertEqualM ""         -- indexWord should return 0 for oob access         (LitByte 0x0)@@ -779,7 +935,37 @@         SolidityCall "x = uint(keccak256(abi.encodePacked(a)));"           [AbiString ""] ===> AbiUInt 256 0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470 -    , testProperty "abi encoding vs. solidity" $ withMaxSuccess 20 $ forAll (arbitrary >>= genAbiValue) $+    , testProperty "symbolic-abi-enc-vs-solidity" $ \(SymbolicAbiVal y) -> prop $ do+          Just encoded <- runStatements [i| x = abi.encode(a);|] [y] AbiBytesDynamicType+          let solidityEncoded = case decodeAbiValue (AbiTupleType $ V.fromList [AbiBytesDynamicType]) (BS.fromStrict encoded) of+                AbiTuple (V.toList -> [e]) -> e+                _ -> internalError "AbiTuple expected"+          let+              frag = [symAbiArg "y" (AbiTupleType $ V.fromList [abiValueType y])]+              (hevmEncoded, _) = first (Expr.drop 4) $ combineFragments frag (ConcreteBuf "")+              expectedVals = expectedConcVals "y" (AbiTuple . V.fromList $ [y])+              hevmConcretePre = subModel expectedVals hevmEncoded+              hevmConcrete = case Expr.simplify hevmConcretePre of+                               ConcreteBuf b -> b+                               buf -> internalError ("valMap: " <> show expectedVals <> "\ny:" <> show y <> "\n" <> "buf: " <> show buf)+          -- putStrLnM $ "frag: " <> show frag+          -- putStrLnM $ "expectedVals: " <> show expectedVals+          -- putStrLnM $ "frag: " <> show frag+          -- putStrLnM $ "hevmEncoded: " <> show hevmEncoded+          -- putStrLnM $ "solidity encoded: " <> show solidityEncoded+          -- putStrLnM $ "our encoded     : " <> show (AbiBytesDynamic hevmConcrete)+          -- putStrLnM $ "y     : " <> show y+          -- putStrLnM $ "y type: " <> showAlter y+          -- putStrLnM $ "hevmConcretePre: " <> show hevmConcretePre+          assertEqualM "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmConcrete)+    , testProperty "symbolic-abi encoding-vs-solidity-2-args" $ \(SymbolicAbiVal x', SymbolicAbiVal y') -> prop $ do+          Just encoded <- runStatements [i| x = abi.encode(a, b);|] [x', y'] AbiBytesDynamicType+          let solidityEncoded = case decodeAbiValue (AbiTupleType $ V.fromList [AbiBytesDynamicType]) (BS.fromStrict encoded) of+                AbiTuple (V.toList -> [e]) -> e+                _ -> internalError "AbiTuple expected"+          let hevmEncoded = encodeAbiValue (AbiTuple $ V.fromList [x',y'])+          assertEqualM "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded)+    , testProperty "abi-encoding-vs-solidity" $ forAll (arbitrary >>= genAbiValue) $       \y -> prop $ do           Just encoded <- runStatements [i| x = abi.encode(a);|]             [y] AbiBytesDynamicType@@ -789,7 +975,7 @@           let hevmEncoded = encodeAbiValue (AbiTuple $ V.fromList [y])           assertEqualM "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded) -    , testProperty "abi encoding vs. solidity (2 args)" $ withMaxSuccess 20 $ forAll (arbitrary >>= bothM genAbiValue) $+    , testProperty "abi-encoding-vs-solidity-2-args" $ forAll (arbitrary >>= bothM genAbiValue) $       \(x', y') -> prop $ do           Just encoded <- runStatements [i| x = abi.encode(a, b);|]             [x', y'] AbiBytesDynamicType@@ -800,7 +986,7 @@           assertEqualM "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded)      -- we need a separate test for this because the type of a function is "function() external" in solidity but just "function" in the abi:-    , testProperty "abi encoding vs. solidity (function pointer)" $ withMaxSuccess 20 $ forAll (genAbiValue AbiFunctionType) $+    , askOption $ \(QuickCheckTests n) -> testProperty "abi-encoding-vs-solidity-function-pointer" $ withMaxSuccess (min n 20) $ forAll (genAbiValue AbiFunctionType) $       \y -> prop $ do           Just encoded <- runFunction [i|               function foo(function() external a) public pure returns (bytes memory x) {@@ -912,7 +1098,7 @@              }             }            |]-       (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x01] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+       (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s [0x01] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts        assertEqualM "Must be 0" 0 $ getVar ctr "arg1"        putStrLnM  $ "expected counterexample found, and it's correct: " <> (show $ getVar ctr "arg1")      ,@@ -925,7 +1111,7 @@               }              }             |]-        (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x11] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s [0x11] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         let x = getVar ctr "arg1"         let y = getVar ctr "arg2" @@ -942,7 +1128,7 @@               }              }             |]-        (_, [Cex (_, ctr)]) <- withSolvers Bitwuzla 1 Nothing $ \s -> checkAssert s [0x12] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, [Cex (_, ctr)]) <- withSolvers Bitwuzla 1 1 Nothing $ \s -> checkAssert s [0x12] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         assertEqualM "Division by 0 needs b=0" (getVar ctr "arg2") 0         putStrLnM "expected counterexample found"      ,@@ -955,7 +1141,7 @@                }              }              |]-         (_, [Cex _]) <- withSolvers Bitwuzla 1 Nothing $ \s -> checkAssert s [0x1] c Nothing [] defaultVeriOpts+         (_, [Cex _]) <- withSolvers Bitwuzla 1 1 Nothing $ \s -> checkAssert s [0x1] c Nothing [] defaultVeriOpts          putStrLnM "expected counterexample found"       ,      test "enum-conversion-fail" $ do@@ -968,7 +1154,7 @@               }              }             |]-        (_, [Cex (_, ctr)]) <- withSolvers Bitwuzla 1 Nothing $ \s -> checkAssert s [0x21] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [Cex (_, ctr)]) <- withSolvers Bitwuzla 1 1 Nothing $ \s -> checkAssert s [0x21] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         assertBoolM "Enum is only defined for 0 and 1" $ (getVar ctr "arg1") > 1         putStrLnM "expected counterexample found"      ,@@ -989,7 +1175,7 @@               }              }             |]-        a <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x31] c (Just (Sig "fun(uint8)" [AbiUIntType 8])) [] defaultVeriOpts+        a <- withDefaultSolver $ \s -> checkAssert s [0x31] c (Just (Sig "fun(uint8)" [AbiUIntType 8])) [] defaultVeriOpts         liftIO $ do           print $ length a           print $ show a@@ -1007,7 +1193,7 @@               }              }             |]-        (_, [Cex (_, _)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x32] c (Just (Sig "fun(uint8)" [AbiUIntType 8])) [] defaultVeriOpts+        (_, [Cex (_, _)]) <- withDefaultSolver $ \s -> checkAssert s [0x32] c (Just (Sig "fun(uint8)" [AbiUIntType 8])) [] defaultVeriOpts         -- assertBoolM "Access must be beyond element 2" $ (getVar ctr "arg1") > 1         putStrLnM "expected counterexample found"       ,@@ -1021,7 +1207,7 @@               }              }             |]-        (_, [Cex _]) <- withSolvers Z3 1 Nothing $ \s ->+        (_, [Cex _]) <- withDefaultSolver $ \s ->           checkAssert s [0x41] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "expected counterexample found"       ,@@ -1043,6 +1229,37 @@         Right e <- reachableUserAsserts c (Just $ Sig "f(address,uint256)" [AbiAddressType, AbiUIntType 256])         assertBoolM "The expression is not partial" $ Expr.containsNode isPartial e       ,+      test "vm.prank-create" $ do+        Just c <- solcRuntime "C"+            [i|+              interface Vm {+                function prank(address) external;+              }+              contract Owned {+                address public owner;+                constructor() {+                  owner = msg.sender;+                }+              }+              contract C {+                function f() external {+                  Vm vm = Vm(0x7109709ECfa91a80626fF3989D68f67F5b1DD12D);++                  Owned target = new Owned();+                  assert(target.owner() == address(this));++                  address usr = address(1312);+                  vm.prank(usr);+                  target = new Owned();+                  assert(target.owner() == usr);+                  target = new Owned();+                  assert(target.owner() == address(this));+                }+              }+            |]+        Right _ <- reachableUserAsserts c (Just $ Sig "f()" [])+        liftIO $ putStrLn "no reachable assertion violations"+      ,       test "vm.prank underflow" $ do         Just c <- solcRuntime "C"             [i|@@ -1109,11 +1326,56 @@               }              }             |]-        (_, [Cex (_, cex)]) <- withSolvers Z3 1 Nothing $+        (_, [Cex (_, cex)]) <- withDefaultSolver $           \s -> checkAssert s [0x51] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         let a = fromJust $ Map.lookup (Var "arg1") cex.vars         assertEqualM "unexpected cex value" a 44         putStrLnM "expected counterexample found"+      ,+      test "symbolic-mcopy" $ do+        Just c <- solcRuntime "MyContract"+            [i|+            contract MyContract {+              function fun(uint256 a, uint256 s) external returns (uint) {+                require(a < 5);+                assembly {+                    mcopy(0x2, 0, s)+                    a:=mload(s)+                }+                assert(a < 5);+                return a;+              }+             }+            |]+        let sig = Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])+        (_, k) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        putStrLnM $ "Ret: " <> (show k)+      ,+      test "symbolic-copyslice" $ do+        Just c <- solcRuntime "MyContract"+            [i|+            contract MyContract {+              function fun(uint256 a, uint256 s) external returns (uint) {+                require(a < 10);+                if (a >= 8) {+                  assembly {+                      calldatacopy(0x5, s, s)+                      a:=mload(s)+                  }+                } else {+                  assembly {+                      calldatacopy(0x2, 0x2, 5)+                      a:=mload(s)+                  }+                }+                assert(a < 9);+                return a;+              }+             }+            |]+        let sig = Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])+        (_, k) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        putStrLnM $ "Ret: " <> (show k)   ]   , testGroup "Symbolic-Constructor-Args"     -- this produced some hard to debug failures. keeping it around since it seemed to exercise the contract creation code in interesting ways...@@ -1137,7 +1399,7 @@                 }             }           |]-        withSolvers Bitwuzla 1 Nothing $ \s -> do+        withSolvers Bitwuzla 1 1 Nothing $ \s -> do           let calldata = (WriteWord (Lit 0x0) (Var "u") (ConcreteBuf ""), [])           initVM <- liftIO $ stToIO $ abstractVM calldata initCode Nothing True           expr <- Expr.simplify <$> interpret (Fetch.oracle s Nothing) Nothing 1 StackBased initVM runExpr@@ -1192,7 +1454,7 @@               , OpPush (Lit 0x0)               , OpCreate               ])-        withSolvers Z3 1 Nothing $ \s -> do+        withDefaultSolver $ \s -> do           vm <- liftIO $ stToIO $ loadSymVM runtimecode (Lit 0) initCode False           expr <- Expr.simplify <$> interpret (Fetch.oracle s Nothing) Nothing 1 StackBased vm runExpr           case expr of@@ -1203,8 +1465,8 @@     [ test "Trivial-Pass" $ do         let testFile = "test/contracts/pass/trivial.sol"         runSolidityTest testFile ".*" >>= assertEqualM "test result" True-    , test "DappTools" $ do-        -- quick smokecheck to make sure that we can parse dapptools style build outputs+    , test "Foundry" $ do+        -- quick smokecheck to make sure that we can parse ForgeStdLib style build outputs         let cases =               [ ("test/contracts/pass/trivial.sol", ".*", True)               , ("test/contracts/pass/dsProvePass.sol", "proveEasy", True)@@ -1212,7 +1474,7 @@               , ("test/contracts/fail/dsProveFail.sol", "prove_add", False)               ]         results <- forM cases $ \(testFile, match, expected) -> do-          actual <- runSolidityTestCustom testFile match Nothing Nothing False Nothing DappTools+          actual <- runSolidityTestCustom testFile match Nothing Nothing False Nothing Foundry           pure (actual == expected)         assertBoolM "test result" (and results)     , test "Trivial-Fail" $ do@@ -1238,7 +1500,7 @@         runSolidityTest testFile "prove_transfer" >>= assertEqualM "should prove transfer" True     , test "badvault-sym-branch" $ do         let testFile = "test/contracts/fail/10_BadVault.sol"-        runSolidityTestCustom testFile "prove_BadVault_usingExploitLaunchPad"  Nothing Nothing True Nothing FoundryStdLib >>= assertEqualM "Must find counterexample" False+        runSolidityTestCustom testFile "prove_BadVault_usingExploitLaunchPad"  Nothing Nothing True Nothing Foundry >>= assertEqualM "Must find counterexample" False     , test "Prove-Tests-Fail" $ do         let testFile = "test/contracts/fail/dsProveFail.sol"         runSolidityTest testFile "prove_trivial" >>= assertEqualM "test result" False@@ -1246,11 +1508,10 @@         runSolidityTest testFile "prove_add" >>= assertEqualM "test result" False         runSolidityTestCustom testFile "prove_smtTimeout" (Just 1) Nothing False Nothing Foundry >>= assertEqualM "test result" False         runSolidityTest testFile "prove_multi" >>= assertEqualM "test result" False-        -- TODO: implement overflow checking optimizations and enable, currently this runs forever-        --runSolidityTest testFile "prove_distributivity" >>= assertEqualM "test result" False+        runSolidityTest testFile "prove_distributivity" >>= assertEqualM "test result" False     , test "Loop-Tests" $ do         let testFile = "test/contracts/pass/loops.sol"-        runSolidityTestCustom testFile "prove_loop" Nothing (Just 10) False Nothing Foundry >>= assertEqualM "test result" True+        runSolidityTestCustom testFile "prove_loop" Nothing (Just 10) False Nothing Foundry  >>= assertEqualM "test result" True         runSolidityTestCustom testFile "prove_loop" Nothing (Just 100) False Nothing Foundry >>= assertEqualM "test result" False     , test "Cheat-Codes-Pass" $ do         let testFile = "test/contracts/pass/cheatCodes.sol"@@ -1276,7 +1537,7 @@             |]         let sig = Just $ Sig "fun()" []             opts = defaultVeriOpts{ maxIter = Just 3 }-        (e, [Qed _]) <- withSolvers Z3 1 Nothing $+        (e, [Qed _]) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts         assertBoolM "The expression is not partial" $ isPartial e     , test "concrete-loops-not-reached" $ do@@ -1293,7 +1554,7 @@          let sig = Just $ Sig "fun()" []             opts = defaultVeriOpts{ maxIter = Just 6 }-        (e, [Qed _]) <- withSolvers Z3 1 Nothing $+        (e, [Qed _]) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts         assertBoolM "The expression is partial" $ not $ isPartial e     , test "symbolic-loops-reached" $ do@@ -1307,7 +1568,7 @@               }             }             |]-        (e, [Qed _]) <- withSolvers Z3 1 Nothing $+        (e, [Qed _]) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] (defaultVeriOpts{ maxIter = Just 5 })         assertBoolM "The expression is not partial" $ Expr.containsNode isPartial e     , test "inconsistent-paths" $ do@@ -1327,9 +1588,31 @@             -- already in an inconsistent path (i == 5, j <= 3, i < j), so we             -- will continue looping here until we hit max iterations             opts = defaultVeriOpts{ maxIter = Just 10, askSmtIters = 5 }-        (e, [Qed _]) <- withSolvers Z3 1 Nothing $+        (e, [Qed _]) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts         assertBoolM "The expression is not partial" $ Expr.containsNode isPartial e+    , test "mem-tuple" $ do+        Just c <- solcRuntime "C"+          [i|+            contract C {+              struct Pair {+                uint x;+                uint y;+              }+              function prove_tuple_pass(Pair memory p) public pure {+                uint256 f = p.x;+                uint256 g = p.y;+                unchecked {+                  p.x+=p.y;+                  assert(p.x == (f + g));+                }+              }+            }+          |]+        let opts = defaultVeriOpts+        let sig = Just $ Sig "prove_tuple_pass((uint256,uint256))" [AbiTupleType (V.fromList [AbiUIntType 256, AbiUIntType 256])]+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] opts+        putStrLnM "Qed, memory tuple is good"     , test "symbolic-loops-not-reached" $ do         Just c <- solcRuntime "C"             [i|@@ -1346,7 +1629,7 @@             -- askSmtIters is low enough here to avoid the inconsistent path             -- conditions, so we never hit maxIters             opts = defaultVeriOpts{ maxIter = Just 5, askSmtIters = 1 }-        (e, [Qed _]) <- withSolvers Z3 1 Nothing $+        (e, [Qed _]) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts         assertBoolM "The expression is partial" $ not (Expr.containsNode isPartial e)     ]@@ -1366,7 +1649,7 @@         Just a <- solcRuntime "A" src         Just c <- solcRuntime "C" src         let sig = Sig "fun(uint256)" [AbiUIntType 256]-        (expr, [Qed _]) <- withSolvers Z3 1 Nothing $ \s ->+        (expr, [Qed _]) <- withDefaultSolver $ \s ->           verifyContract s c (Just sig) [] defaultVeriOpts Nothing Nothing         let isSuc (Success {}) = True             isSuc _ = False@@ -1540,7 +1823,7 @@         Just c <- solcRuntime "C"           [i|             interface Vm {-              function load(address,bytes32) external;+              function load(address,bytes32) external returns (bytes32);             }             contract C {               function f() external {@@ -1549,7 +1832,8 @@               }             }           |]-        (_, [Cex _]) <- withSolvers Z3 1 Nothing $ \s ->+        -- NOTE: we have a postcondition here, not just a regular verification+        (_, [Cex _]) <- withDefaultSolver $ \s ->           verifyContract s c Nothing [] defaultVeriOpts Nothing (Just $ checkBadCheatCode "load(address,bytes32)")         pure ()     , test "vm.store fails for a potentially aliased address" $ do@@ -1565,7 +1849,8 @@               }             }           |]-        (_, [Cex _]) <- withSolvers Z3 1 Nothing $ \s ->+        -- NOTE: we have a postcondition here, not just a regular verification+        (_, [Cex _]) <- withDefaultSolver $ \s ->           verifyContract s c Nothing [] defaultVeriOpts Nothing (Just $ checkBadCheatCode "store(address,bytes32,bytes32)")         pure ()     -- TODO: make this work properly@@ -1655,7 +1940,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256)" [AbiIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256)" [AbiIntType 256])) [] defaultVeriOpts         putStrLnM "Require works as expected"      ,      -- here test@@ -1676,7 +1961,7 @@          }          |]        -- should find a counterexample-       (_, [Cex _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+       (_, [Cex _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts        putStrLnM "expected counterexample found"      ,      test "ITE-with-bitwise-OR" $ do@@ -1694,8 +1979,22 @@            }          }          |]-       (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+       (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts        putStrLnM "this should always be true, due to bitwise OR with positive value"+     ,+     test "abstract-returndata-size" $ do+       Just c <- solcRuntime "C"+         [i|+         contract C {+           function f(uint256 x) public pure {+             assembly {+                 return(0, x)+             }+           }+         }+         |]+       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "f(uint256)" [])) [] defaultVeriOpts+       assertBoolM "The expression is partial" $ not $ Expr.containsNode isPartial expr     ,     -- CopySlice check     -- uses identity precompiled contract (0x4) to copy memory@@ -1721,7 +2020,7 @@         }         |]       let sig = Just (Sig "checkval(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-      (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s ->+      (res, [Qed _]) <- withDefaultSolver $ \s ->         checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"      ,@@ -1744,7 +2043,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256,int256)" [AbiIntType 256, AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256,int256)" [AbiIntType 256, AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "MUL is associative"      ,      -- TODO look at tests here for SAR: https://github.com/dapphub/dapptools/blob/01ef8ea418c3fe49089a44d56013d8fcc34a1ec2/src/dapp-tests/pass/constantinople.sol#L250@@ -1762,7 +2061,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-sar-pos" $ do@@ -1779,7 +2078,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-sar-fixedval-pos" $ do@@ -1796,7 +2095,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-sar-fixedval-neg" $ do@@ -1813,7 +2112,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-div-zero-1" $ do@@ -1830,7 +2129,7 @@               }             }             |]-        (_, [Qed _])  <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "sdiv works as expected"       ,      test "opcode-sdiv-zero-1" $ do@@ -1847,7 +2146,7 @@               }             }             |]-        (_, [Qed _])  <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "sdiv works as expected"       ,      test "opcode-sdiv-zero-2" $ do@@ -1864,7 +2163,7 @@               }             }             |]-        (_, [Qed _])  <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _])  <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "sdiv works as expected"       ,      test "signed-overflow-checks" $ do@@ -1876,7 +2175,7 @@               }             }             |]-        (_, [Cex (_, _)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x11] c (Just (Sig "fun(int256)" [AbiIntType 256])) [] defaultVeriOpts+        (_, [Cex (_, _)]) <- withDefaultSolver $ \s -> checkAssert s [0x11] c (Just (Sig "fun(int256)" [AbiIntType 256])) [] defaultVeriOpts         putStrLnM "expected cex discovered"       ,      test "opcode-signextend-neg" $ do@@ -1898,7 +2197,7 @@               }             }             |]-        (_, [Qed _])  <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "signextend works as expected"       ,      test "opcode-signextend-pos-nochop" $ do@@ -1916,7 +2215,7 @@               }             }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts         putStrLnM "signextend works as expected"       ,       test "opcode-signextend-pos-chopped" $ do@@ -1934,7 +2233,7 @@               }             }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts         putStrLnM "signextend works as expected"       ,       -- when b is too large, value is unchanged@@ -1952,7 +2251,7 @@               }             }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts         putStrLnM "signextend works as expected"      ,      test "opcode-shl" $ do@@ -1970,7 +2269,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-xor-cancel" $ do@@ -1987,7 +2286,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "XOR works as expected"       ,       test "opcode-xor-reimplement" $ do@@ -2003,7 +2302,7 @@               }              }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "XOR works as expected"       ,       test "opcode-add-commutative" $ do@@ -2021,7 +2320,7 @@               }             }             |]-        a <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        a <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         case a of           (_, [Cex (_, ctr)]) -> do             let x = getVar ctr "arg1"@@ -2047,7 +2346,7 @@               }             }             |]-        (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint16)" [AbiUIntType 16])) [] defaultVeriOpts+        (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint16)" [AbiUIntType 16])) [] defaultVeriOpts         putStrLnM "DIV by zero is zero"       ,       -- Somewhat tautological since we are asserting the precondition@@ -2075,7 +2374,7 @@                    Success _ _ b _ -> (ReadWord (Lit 0) b) .== (Add x y)                    _ -> PBool True             sig = Just (Sig "add(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-        (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s ->+        (res, [Qed _]) <- withDefaultSolver $ \s ->           verifyContract s safeAdd sig [] defaultVeriOpts (Just pre) (Just post)         putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"      ,@@ -2102,7 +2401,7 @@               in case leaf of                    Success _ _ b _ -> (ReadWord (Lit 0) b) .== (Mul (Lit 2) y)                    _ -> PBool True-        (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s ->+        (res, [Qed _]) <- withDefaultSolver $ \s ->           verifyContract s safeAdd (Just (Sig "add(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts (Just pre) (Just post)         putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"       ,@@ -2123,7 +2422,7 @@             post prestate leaf =               let y = case getStaticAbiArgs 1 prestate of                         [y'] -> y'-                        _ -> error "expected 1 arg"+                        _ -> internalError "expected 1 arg"                   this = prestate.state.codeContract                   prestore = (fromJust (Map.lookup this prestate.env.contracts)).storage                   prex = Expr.readStorage' (Lit 0) prestore@@ -2133,7 +2432,7 @@                   in Expr.add prex (Expr.mul (Lit 2) y) .== (Expr.readStorage' (Lit 0) poststore)                 _ -> PBool True             sig = Just (Sig "f(uint256)" [AbiUIntType 256])-        (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s ->+        (res, [Qed _]) <- withDefaultSolver $ \s ->           verifyContract s c sig [] defaultVeriOpts (Just pre) (Just post)         putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,@@ -2159,7 +2458,7 @@                     }                     |]             Just c <- liftIO $ yulRuntime "Neg" src-            (res, [Qed _]) <- withSolvers Z3 4 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "hello(address)" [AbiAddressType])) [] defaultVeriOpts+            (res, [Qed _]) <- withSolvers Z3 4 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "hello(address)" [AbiAddressType])) [] defaultVeriOpts             putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "catch-storage-collisions-noproblem" $ do@@ -2195,7 +2494,7 @@                        in Expr.add prex prey .== Expr.add postx posty                      _ -> PBool True               sig = Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-          (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s ->+          (_, [Qed _]) <- withDefaultSolver $ \s ->             verifyContract s c sig [] defaultVeriOpts (Just pre) (Just post)           putStrLnM "Correct, this can never fail"         ,@@ -2232,7 +2531,7 @@                        in Expr.add prex prey .== Expr.add postx posty                      _ -> PBool True               sig = Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-          (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s ->+          (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s ->             verifyContract s c sig [] defaultVeriOpts (Just pre) (Just post)           let x = getVar ctr "arg1"           let y = getVar ctr "arg2"@@ -2250,7 +2549,7 @@               }              }             |]-          (_, [Cex (Failure _ _ (Revert msg), _)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo()" [])) [] defaultVeriOpts+          (_, [Cex (Failure _ _ (Revert msg), _)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo()" [])) [] defaultVeriOpts           assertEqualM "incorrect revert msg" msg (ConcreteBuf $ panicMsg 0x01)         ,         test "simple-assert-2" $ do@@ -2262,7 +2561,7 @@               }              }             |]-          (_, [(Cex (_, ctr))]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [(Cex (_, ctr))]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           assertEqualM "Must be 10" 10 $ getVar ctr "arg1"           putStrLnM "Got 10 Cex, as expected"         ,@@ -2276,7 +2575,7 @@               }              }             |]-          (_, [Cex (_, a), Cex (_, b)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Cex (_, a), Cex (_, b)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           let ints = map (flip getVar "arg1") [a,b]           assertBoolM "0 must be one of the Cex-es" $ isJust $ List.elemIndex 0 ints           putStrLnM "expected 2 counterexamples found, one Cex is the 0 value"@@ -2291,7 +2590,7 @@               }              }             |]-          (_, [Cex (_, a), Cex (_, b)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Cex (_, a), Cex (_, b)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           let x = getVar a "arg1"           let y = getVar b "arg1"           assertBoolM "At least one has to be 0, to go through the first assert" (x == 0 || y == 0)@@ -2307,7 +2606,7 @@               }              }             |]-          (_, [Cex _, Cex _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (_, [Cex _, Cex _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "expected 2 counterexamples found"         ,         test "assert-2nd-arg" $ do@@ -2319,7 +2618,7 @@               }              }             |]-          (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           assertEqualM "Must be 666" 666 $ getVar ctr "arg2"           putStrLnM "Found arg2 Ctx to be 666"         ,@@ -2336,7 +2635,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         -- We zero out everything but the LSB byte. However, byte(31,x) takes the LSB byte@@ -2353,7 +2652,7 @@               }             }             |]-          (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           assertBoolM "last byte must be non-zero" $ ((Data.Bits..&.) (getVar ctr "arg1") 0xff) > 0           putStrLnM "Expected counterexample found"         ,@@ -2371,7 +2670,7 @@               }             }             |]-          (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           assertBoolM "second to last byte must be non-zero" $ ((Data.Bits..&.) (getVar ctr "arg1") 0xff00) > 0           putStrLnM "Expected counterexample found"         ,@@ -2390,7 +2689,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         -- Bitwise OR operation test@@ -2406,7 +2705,7 @@               }             }             |]-          (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "When OR-ing with full 1's we should get back full 1's"         ,         -- Bitwise OR operation test@@ -2423,7 +2722,7 @@               }             }             |]-          (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "When OR-ing with a byte of 1's, we should get 1's back there"         ,         test "Deposit contract loop (z3)" $ do@@ -2445,7 +2744,7 @@               }              }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "deposit(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "deposit(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "Deposit-contract-loop-error-version" $ do@@ -2467,7 +2766,7 @@               }              }             |]-          (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s allPanicCodes c (Just (Sig "deposit(uint8)" [AbiUIntType 8])) [] defaultVeriOpts+          (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s allPanicCodes c (Just (Sig "deposit(uint8)" [AbiUIntType 8])) [] defaultVeriOpts           assertEqualM "Must be 255" 255 $ getVar ctr "arg1"           putStrLnM  $ "expected counterexample found, and it's correct: " <> (show $ getVar ctr "arg1")         ,@@ -2480,7 +2779,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "check-asm-byte-in-bounds" $ do@@ -2499,7 +2798,7 @@               }             }             |]-          (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts           putStrLnM "in bounds byte reads return the expected value"         ,         test "check-div-mod-sdiv-smod-by-zero-constant-prop" $ do@@ -2529,7 +2828,7 @@               }             }             |]-          (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "div/mod/sdiv/smod by zero works as expected during constant propagation"         ,         test "check-asm-byte-oob" $ do@@ -2544,7 +2843,7 @@               }             }             |]-          (_, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts           putStrLnM "oob byte reads always return 0"         ,         test "injectivity of keccak (diff sizes)" $ do@@ -2571,7 +2870,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "injectivity of keccak contrapositive (32 bytes)" $ do@@ -2584,7 +2883,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "injectivity of keccak (64 bytes)" $ do@@ -2596,7 +2895,7 @@               }             }             |]-          (_, [Cex (_, ctr)]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256,uint256,uint256)" (replicate 4 (AbiUIntType 256)))) [] defaultVeriOpts+          (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256,uint256,uint256)" (replicate 4 (AbiUIntType 256)))) [] defaultVeriOpts           let x = getVar ctr "arg1"           let y = getVar ctr "arg2"           let w = getVar ctr "arg3"@@ -2619,7 +2918,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "calldata beyond calldatasize is 0 (concrete dalldata prefix)" $ do@@ -2636,7 +2935,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "calldata symbolic access" $ do@@ -2649,6 +2948,7 @@                   y := calldatasize()                 }                 require(z >= y);+                require(z < 2**64); // Accesses to larger indices are not supported                 assembly {                   x := calldataload(z)                 }@@ -2656,7 +2956,7 @@               }             }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "multiple-contracts" $ do@@ -2679,7 +2979,7 @@               cAddr = SymAddr "entrypoint"           Just c <- solcRuntime "C" code           Just a <- solcRuntime "A" code-          (_, [Cex (_, cex)]) <- withSolvers Z3 1 Nothing $ \s -> do+          (_, [Cex (_, cex)]) <- withDefaultSolver $ \s -> do             vm <- liftIO $ stToIO $ abstractVM (mkCalldata (Just (Sig "call_A()" [])) []) c Nothing False                     <&> set (#state % #callvalue) (Lit 0)                     <&> over (#env % #contracts)@@ -2713,7 +3013,7 @@                 uint public x;               }             |]-          (_, [Cex _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "call_A()" [])) [] defaultVeriOpts+          (_, [Cex _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "call_A()" [])) [] defaultVeriOpts           putStrLnM "expected counterexample found"         ,         test "keccak-concrete-and-sym-agree" $ do@@ -2727,7 +3027,7 @@                 }               }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "keccak-concrete-and-sym-agree-nonzero" $ do@@ -2742,7 +3042,7 @@                 }               }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "keccak concrete and sym injectivity" $ do@@ -2754,13 +3054,13 @@                 }               }             |]-          (res, [Qed _]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (res, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"         ,         test "safemath-distributivity-yul" $ do           let yulsafeDistributivity = hex "6355a79a6260003560e01c14156016576015601f565b5b60006000fd60a1565b603d602d604435600435607c565b6039602435600435607c565b605d565b6052604b604435602435605d565b600435607c565b141515605a57fe5b5b565b6000828201821115151560705760006000fd5b82820190505b92915050565b6000818384048302146000841417151560955760006000fd5b82820290505b92915050565b"           vm <- liftIO $ stToIO $ abstractVM (mkCalldata (Just (Sig "distributivity(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) []) yulsafeDistributivity Nothing False-          (_, [Qed _]) <-  withSolvers Z3 1 Nothing $ \s -> verify s defaultVeriOpts vm (Just $ checkAssertions defaultPanicCodes)+          (_, [Qed _]) <-  withDefaultSolver $ \s -> verify s defaultVeriOpts vm (Just $ checkAssertions defaultPanicCodes)           putStrLnM "Proven"         ,         test "safemath-distributivity-sol" $ do@@ -2785,7 +3085,7 @@               }             |] -          (_, [Qed _]) <- withSolvers Bitwuzla 1 (Just 99999999) $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "distributivity(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (_, [Qed _]) <- withSolvers Bitwuzla 1 1 (Just 99999999) $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "distributivity(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "Proven"         ,         test "storage-cex-1" $ do@@ -2801,7 +3101,7 @@               }             }             |]-          (_, [(Cex (_, cex))]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x01] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [(Cex (_, cex))]) <- withDefaultSolver $ \s -> checkAssert s [0x01] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           let addr = SymAddr "entrypoint"               testCex = Map.size cex.store == 1 &&                         case Map.lookup addr cex.store of@@ -2824,7 +3124,7 @@               }             }             |]-          (_, [(Cex (_, cex))]) <- withSolvers Z3 1 Nothing $ \s -> checkAssert s [0x01] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, [(Cex (_, cex))]) <- withDefaultSolver $ \s -> checkAssert s [0x01] c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           let addr = SymAddr "entrypoint"               a = getVar cex "arg1"               testCex = Map.size cex.store == 1 &&@@ -2851,7 +3151,7 @@             }             |]           let sig = Just (Sig "fun(uint256)" [AbiUIntType 256])-          (_, [Cex (_, cex)]) <- withSolvers Z3 1 Nothing $+          (_, [Cex (_, cex)]) <- withDefaultSolver $             \s -> verifyContract s c sig [] defaultVeriOpts Nothing (Just $ checkAssertions [0x01])           let addr = SymAddr "entrypoint"               testCex = Map.size cex.store == 1 &&@@ -2863,6 +3163,29 @@                           _ -> False           assertBoolM "Did not find expected storage cex" testCex           putStrLnM "Expected counterexample found"+        , test "temp-store-check" $ do+          Just c <- solcRuntime "C"+            [i|+            pragma solidity ^0.8.25;+            contract C {+                mapping(address => bool) sentGifts;+                function stuff(address k) public {+                    require(sentGifts[k] == false);+                    assembly {+                        if tload(0) { revert(0, 0) }+                        tstore(0, 1)+                    }+                    sentGifts[k] = true;+                    assembly {+                        tstore(0, 0)+                    }+                    assert(sentGifts[k]);+                }+            }+            |]+          let sig = (Just (Sig "stuff(address)" [AbiAddressType]))+          (_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+          putStrLnM $ "Basic tstore check passed"   ]   , testGroup "concr-fuzz"     [ testFuzz "fuzz-complicated-mul" $ do@@ -2881,7 +3204,7 @@         }         |]       let sig = (Sig "complicated(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])-      (_, [Cex (_, ctr)]) <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex (_, ctr)]) <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       let         x = getVar ctr "arg1"         y = getVar ctr "arg2"@@ -2903,7 +3226,7 @@         }         |]       let sig = (Sig "func()" [])-      (_, [Cex (_, ctr)]) <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex (_, ctr)]) <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       putStrLnM  $ "expected counterexample found.  ctr: " <> (show ctr)     , testFuzz "fuzz-simple-fixed-value" $ do       Just c <- solcRuntime "MyContract"@@ -2916,7 +3239,7 @@         }         |]       let sig = (Sig "func(uint256)" [AbiUIntType 256])-      (_, [Cex (_, ctr)]) <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex (_, ctr)]) <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       putStrLnM  $ "expected counterexample found.  ctr: " <> (show ctr)     , testFuzz "fuzz-simple-fixed-value2" $ do       Just c <- solcRuntime "MyContract"@@ -2928,7 +3251,7 @@         }         |]       let sig = (Sig "func(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-      (_, [Cex (_, ctr)]) <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex (_, ctr)]) <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       putStrLnM  $ "expected counterexample found.  ctr: " <> (show ctr)     , testFuzz "fuzz-simple-fixed-value3" $ do       Just c <- solcRuntime "MyContract"@@ -2940,7 +3263,7 @@         }         |]       let sig = (Sig "func(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-      (_, [Cex (_, ctr1), Cex (_, ctr2)]) <- withSolvers Bitwuzla 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex (_, ctr1), Cex (_, ctr2)]) <- withSolvers Bitwuzla 1 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       putStrLnM  $ "expected counterexamples found.  ctr1: " <> (show ctr1) <> " ctr2: " <> (show ctr2)     , testFuzz "fuzz-simple-fixed-value-store1" $ do       Just c <- solcRuntime "MyContract"@@ -2954,7 +3277,7 @@         }         |]       let sig = (Sig "func(uint256)" [AbiUIntType 256, AbiUIntType 256])-      (_, [Cex _]) <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex _]) <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       putStrLnM  $ "expected counterexamples found"     , testFuzz "fuzz-simple-fixed-value-store2" $ do       Just c <- solcRuntime "MyContract"@@ -2968,7 +3291,7 @@         }         |]       let sig = (Sig "func(uint256)" [AbiUIntType 256, AbiUIntType 256])-      (_, [Cex (_, ctr1)]) <- withSolvers CVC5 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts+      (_, [Cex (_, ctr1)]) <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just sig) [] defaultVeriOpts       putStrLnM  $ "expected counterexamples found: " <> show ctr1   ]   , testGroup "simplification-working"@@ -3021,21 +3344,21 @@       let a = [PAnd (PGEq (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x44)) (PLT (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x10000000000000000)), PAnd (PGEq (Var "arg1") (Lit 0x0)) (PLEq (Var "arg1") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PEq (Lit 0x63) (Var "arg2"),PEq (Lit 0x539) (Var "arg1"),PEq TxValue (Lit 0x0),PEq (IsZero (Eq (Lit 0x63) (Var "arg2"))) (Lit 0x0)]       let simp = Expr.simplifyProps a       assertEqualM "must not duplicate" simp (nubOrd simp)-      assertEqualM "We must be able to remove all duplicates" (length $ nubOrd simp) (length $ DLU.uniq simp)+      assertEqualM "We must be able to remove all duplicates" (length $ nubOrd simp) (length $ List.nub simp)     , test "propSimp-no-duplicate2" $ do       let a = [PNeg (PBool False),PAnd (PGEq (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x44)) (PLT (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x10000000000000000)),PAnd (PGEq (Var "arg2") (Lit 0x0)) (PLEq (Var "arg2") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PAnd (PGEq (Var "arg1") (Lit 0x0)) (PLEq (Var "arg1") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PEq (Lit 0x539) (Var "arg1"),PNeg (PEq (Lit 0x539) (Var "arg1")),PEq TxValue (Lit 0x0),PLT (BufLength (AbstractBuf "txdata")) (Lit 0x10000000000000000),PEq (IsZero (Eq (Lit 0x539) (Var "arg1"))) (Lit 0x0),PNeg (PEq (IsZero (Eq (Lit 0x539) (Var "arg1"))) (Lit 0x0)),PNeg (PEq (IsZero TxValue) (Lit 0x0))]       let simp = Expr.simplifyProps a       assertEqualM "must not duplicate" simp (nubOrd simp)-      assertEqualM "must not duplicate" (length simp) (length $ DLU.uniq simp)+      assertEqualM "must not duplicate" (length simp) (length $ List.nub simp)     , test "full-order-prop1" $ do       let a = [PNeg (PBool False),PAnd (PGEq (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x44)) (PLT (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x10000000000000000)),PAnd (PGEq (Var "arg2") (Lit 0x0)) (PLEq (Var "arg2") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PAnd (PGEq (Var "arg1") (Lit 0x0)) (PLEq (Var "arg1") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PEq (Lit 0x539) (Var "arg1"),PNeg (PEq (Lit 0x539) (Var "arg1")),PEq TxValue (Lit 0x0),PLT (BufLength (AbstractBuf "txdata")) (Lit 0x10000000000000000),PEq (IsZero (Eq (Lit 0x539) (Var "arg1"))) (Lit 0x0),PNeg (PEq (IsZero (Eq (Lit 0x539) (Var "arg1"))) (Lit 0x0)),PNeg (PEq (IsZero TxValue) (Lit 0x0))]       let simp = Expr.simplifyProps a-      assertEqualM "We must be able to remove all duplicates" (length $ nubOrd simp) (length $ DLU.uniq simp)+      assertEqualM "We must be able to remove all duplicates" (length $ nubOrd simp) (length $ List.nub simp)     , test "full-order-prop2" $ do       let a =[PNeg (PBool False),PAnd (PGEq (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x44)) (PLT (Max (Lit 0x44) (BufLength (AbstractBuf "txdata"))) (Lit 0x10000000000000000)),PAnd (PGEq (Var "arg2") (Lit 0x0)) (PLEq (Var "arg2") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PAnd (PGEq (Var "arg1") (Lit 0x0)) (PLEq (Var "arg1") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)),PEq (Lit 0x63) (Var "arg2"),PEq (Lit 0x539) (Var "arg1"),PEq TxValue (Lit 0x0),PLT (BufLength (AbstractBuf "txdata")) (Lit 0x10000000000000000),PEq (IsZero (Eq (Lit 0x63) (Var "arg2"))) (Lit 0x0),PEq (IsZero (Eq (Lit 0x539) (Var "arg1"))) (Lit 0x0),PNeg (PEq (IsZero TxValue) (Lit 0x0))]       let simp = Expr.simplifyProps a       assertEqualM "must not duplicate" simp (nubOrd simp)-      assertEqualM "We must be able to remove all duplicates" (length $ nubOrd simp) (length $ DLU.uniq simp)+      assertEqualM "We must be able to remove all duplicates" (length $ nubOrd simp) (length $ List.nub simp)   ]   , testGroup "equivalence-checking"     [@@ -3060,7 +3383,7 @@             default { invalid() }           }           |]-        withSolvers Z3 3 Nothing $ \s -> do+        withSolvers Z3 3 1 Nothing $ \s -> do           a <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts (mkCalldata Nothing [])           assertBoolM "Must have a difference" (any isCex a)       ,@@ -3085,7 +3408,7 @@               }             }           |]-        withSolvers Z3 3 Nothing $ \s -> do+        withSolvers Z3 3 1 Nothing $ \s -> do           a <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts (mkCalldata Nothing [])           assertEqualM "Must have no difference" [Qed ()] a       ,@@ -3116,7 +3439,7 @@               }             }           |]-        withSolvers Z3 3 Nothing $ \s -> do+        withSolvers Z3 3 1 Nothing $ \s -> do           a <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts (mkCalldata Nothing [])           assertBoolM "Must differ" (all isCex a)       ,@@ -3177,7 +3500,7 @@               }             }           |]-        withSolvers Z3 3 Nothing $ \s -> do+        withSolvers Z3 3 1 Nothing $ \s -> do           a <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts (mkCalldata Nothing [])           assertBoolM "Must differ" (all isCex a)       ,@@ -3200,7 +3523,7 @@               }             }           |]-        withSolvers Z3 3 Nothing $ \s -> do+        withSolvers Z3 3 1 Nothing $ \s -> do           let cd = mkCalldata (Just (Sig "a(address,address)" [AbiAddressType, AbiAddressType])) []           a <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts cd           assertEqualM "Must be different" (any isCex a) True@@ -3226,7 +3549,7 @@                 }               }           |]-        withSolvers Bitwuzla 3 Nothing $ \s -> do+        withSolvers Bitwuzla 3 1 Nothing $ \s -> do           a <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts (mkCalldata Nothing [])           assertEqualM "Must be different" (any isCex a) True       , test "eq-all-yul-optimization-tests" $ do@@ -3254,76 +3577,31 @@                     , "loopInvariantCodeMotion/no_move_state.yul" -- not infinite, but rollaround on a large int                     , "loopInvariantCodeMotion/no_move_loop.yul" -                    -- unexpected symbolic arg ----                    -- OpCreate2-                    , "expressionSimplifier/create2_and_mask.yul"--                    -- OpCreate-                    , "expressionSimplifier/create_and_mask.yul"-                    , "expressionSimplifier/large_byte_access.yul"+                    -- infinite recursion+                    , "unusedStoreEliminator/function_side_effects_2.yul"+                    , "unusedStoreEliminator/write_before_recursion.yul"+                    , "fullInliner/multi_fun_callback.yul"+                    , "conditionalUnsimplifier/side_effects_of_functions.yul"+                    , "expressionInliner/double_recursive_calls.yul"+                    , "conditionalSimplifier/side_effects_of_functions.yul" -                    -- OpMload-                    , "yulOptimizerTests/expressionSplitter/inside_function.yul"-                    , "fullInliner/double_inline.yul"-                    , "fullInliner/inside_condition.yul"-                    , "fullInliner/large_function_multi_use.yul"-                    , "fullInliner/large_function_single_use.yul"-                    , "fullInliner/no_inline_into_big_global_context.yul"-                    , "fullSimplify/invariant.yul"+                    -- Takes too long, would timeout on most test setups.+                    -- We could probably fix these by "bunching together" queries+                    , "reasoningBasedSimplifier/mulmod.yul"+                    , "loadResolver/multi_sload_loop.yul"+                    , "reasoningBasedSimplifier/mulcheck.yul"+                    , "reasoningBasedSimplifier/smod.yul"                     , "fullSuite/abi_example1.yul"-                    , "ssaAndBack/for_loop.yul"-                    , "ssaAndBack/multi_assign_multi_var_if.yul"-                    , "ssaAndBack/multi_assign_multi_var_switch.yul"-                    , "ssaAndBack/two_vars.yul"-                    , "ssaTransform/multi_assign.yul"-                    , "ssaTransform/multi_decl.yul"-                    , "expressionSplitter/inside_function.yul"-                    , "fullSuite/ssaReverseComplex.yul"--                    -- OpMstore-                    , "commonSubexpressionEliminator/function_scopes.yul"-                    , "commonSubexpressionEliminator/variable_for_variable.yul"-                    , "expressionSplitter/trivial.yul"-                    , "fullInliner/multi_return.yul"-                    , "fullSimplify/constant_propagation.yul"-                    , "fullSimplify/identity_rules_complex.yul"-                    , "fullSuite/medium.yul"-                    , "loadResolver/memory_with_msize.yul"-                    , "loadResolver/merge_known_write.yul"+                    , "yulOptimizerTests/fullInliner/large_function_multi_use.yul"                     , "loadResolver/merge_known_write_with_distance.yul"-                    , "loadResolver/merge_unknown_write.yul"-                    , "loadResolver/reassign_value_expression.yul"                     , "loadResolver/second_mstore_with_delta.yul"-                    , "loadResolver/second_store_with_delta.yul"-                    , "loadResolver/simple.yul"-                    , "loadResolver/simple_memory.yul"-                    , "fullSuite/ssaReverse.yul"-                    , "rematerialiser/cheap_caller.yul"-                    , "rematerialiser/non_movable_instruction.yul"-                    , "rematerialiser/for_break.yul"-                    , "rematerialiser/for_continue.yul"                     , "rematerialiser/for_continue_2.yul"-                    , "ssaAndBack/multi_assign.yul"-                    , "ssaAndBack/multi_assign_if.yul"-                    , "ssaAndBack/multi_assign_switch.yul"-                    , "ssaAndBack/simple.yul"-                    , "ssaReverser/simple.yul"-                    , "loopInvariantCodeMotion/simple_storage.yul"--                    -- OpMstore8-                    , "loadResolver/memory_with_different_kinds_of_invalidation.yul"--                    -- OpRevert-                    , "ssaAndBack/ssaReverse.yul"-                    , "redundantAssignEliminator/for_continue_3.yul"-                    , "controlFlowSimplifier/terminating_for_revert.yul"+                    , "rematerialiser/for_continue_with_assignment_in_post.yul"                      -- invalid test --                     -- https://github.com/ethereum/solidity/issues/9500                     , "commonSubexpressionEliminator/object_access.yul"                     , "expressionSplitter/object_access.yul"-                    , "fullSuite/stack_compressor_msize.yul"                      -- stack too deep --                     , "fullSuite/abi2.yul"@@ -3336,17 +3614,6 @@                     , "controlFlowSimplifier/switch_only_default.yul"                     , "stackLimitEvader" -- all that are in this subdirectory -                    -- wrong number of args ---                    , "wordSizeTransform/functional_instruction.yul"-                    , "wordSizeTransform/if.yul"-                    , "wordSizeTransform/or_bool_renamed.yul"-                    , "wordSizeTransform/switch_1.yul"-                    , "wordSizeTransform/switch_2.yul"-                    , "wordSizeTransform/switch_3.yul"-                    , "wordSizeTransform/switch_4.yul"-                    , "wordSizeTransform/switch_5.yul"-                    , "unusedFunctionParameterPruner/too_many_arguments.yul"-                     -- typed yul --                     , "conditionalSimplifier/add_correct_type_wasm.yul"                     , "conditionalSimplifier/add_correct_type.yul"@@ -3423,16 +3690,14 @@                     , "fullSuite/extcodelength.yul"                     , "unusedStoreEliminator/create_inside_function.yul"-- "trying to reset symbolic storage with writes in create" -                    -- Takes too long, would timeout on most test setups.-                    -- We could probably fix these by "bunching together" queries-                    , "reasoningBasedSimplifier/mulmod.yul"-                    , "loadResolver/multi_sload_loop.yul"-                    , "reasoningBasedSimplifier/mulcheck.yul"-                    , "reasoningBasedSimplifier/smod.yul"--                    -- TODO check what's wrong with these!-                    , "loadResolver/keccak_short.yul" -- ACTUAL bug -- keccak-                    , "reasoningBasedSimplifier/signed_division.yul" -- ACTUAL bug, SDIV+                    -- Due to tstorage warnings treated as errors when running solc with --standard-json+                    --   these cannot be currently run. See: https://github.com/ethereum/solidity/issues/15397+                    --   When that fix comes to upstream, we can re-enabled again+                    , "equalStoreEliminator/transient_storage.yul"+                    , "unusedStoreEliminator/tload.yul"+                    , "unusedStoreEliminator/tstore.yul"+                    , "yulOptimizerTests/fullSuite/transient_storage.yul"+                    , "yulOptimizerTests/unusedPruner/transient_storage.yul"                     ]          solcRepo <- liftIO $ fromMaybe (internalError "cannot find solidity repo") <$> (lookupEnv "HEVM_SOLIDITY_REPO")@@ -3456,6 +3721,7 @@         -- Takes one file which follows the Solidity Yul optimizer unit tests format,         -- extracts both the nonoptimized and the optimized versions, and checks equivalence.         forM_ filesFiltered (\f-> do+          liftIO $ print f           origcont <- liftIO $ readFile f           let             onlyAfter pattern (a:ax) = if a =~ pattern then (a:ax) else onlyAfter pattern ax@@ -3492,16 +3758,17 @@           Just aPrgm <- liftIO $ yul "" $ T.pack $ unlines filteredASym           Just bPrgm <- liftIO $ yul "" $ T.pack $ unlines filteredBSym           procs <- liftIO $ getNumProcessors-          withSolvers CVC5 (unsafeInto procs) (Just 100) $ \s -> do+          withSolvers CVC5 (unsafeInto procs) 1 (Just 100) $ \s -> do             res <- equivalenceCheck s aPrgm bPrgm opts (mkCalldata Nothing [])             end <- liftIO $ getCurrentTime             case any isCex res of               False -> liftIO $ do                 print $ "OK. Took " <> (show $ diffUTCTime end start) <> " seconds"-                let timeouts = filter isTimeout res-                unless (null timeouts) $ do-                  putStrLnM $ "But " <> (show $ length timeouts) <> " timeout(s) occurred"-                  internalError "Encountered timeouts"+                let timeouts = filter isUnknown res+                let errors = filter isError res+                unless (null timeouts && null errors) $ do+                  putStrLnM $ "But " <> (show $ length timeouts) <> " timeout(s) and " <>  (show $ length errors) <> " error(s) occurred"+                  internalError "Encountered timeout(s) and/or error(s)"               True -> liftIO $ do                 putStrLnM $ "Not OK: " <> show f <> " Got: " <> show res                 internalError "Was NOT equivalent"@@ -3512,29 +3779,47 @@     (===>) = assertSolidityComputation  checkEquivProp :: App m => Prop -> Prop -> m Bool-checkEquivProp = checkEquivBase (\l r -> PNeg (PImpl l r .&& PImpl r l))+checkEquivProp a b = fmap (fromMaybe True) $ checkEquivBase (\l r -> PNeg (PImpl l r .&& PImpl r l)) a b True +checkEquivPropAndLHS :: App m => Prop -> Prop -> m Bool+checkEquivPropAndLHS orig simp = do+  let lhsConst = Expr.checkLHSConstProp simp+  equiv <- checkEquivProp orig simp+  pure $ lhsConst && equiv+ checkEquiv :: (Typeable a, App m) => Expr a -> Expr a -> m Bool-checkEquiv = checkEquivBase (./=)+checkEquiv a b = do+  opts <- readConfig+  if a == b then pure True else do+    when (opts.debug) $ liftIO $ putStrLn $ "Checking equivalence of " <> show a <> " and " <> show b+    x <- checkEquivBase (./=) a b True+    when (opts.debug) $ liftIO $ putStrLn $ "UNSAT check, expect True: " <> show x+    y <- checkEquivBase (.==) a b False+    when (opts.debug) $ liftIO $ putStrLn $ "SAT check, expect False: " <> show y+    pure $ (fromMaybe True x) && not (fromMaybe False y) -checkEquivBase :: (Eq a, App m) => (a -> a -> Prop) -> a -> a -> m Bool-checkEquivBase mkprop l r = do-  conf <-  readConfig-  withSolvers Z3 1 (Just 1) $ \solvers -> liftIO $ do-    if l == r-       then do-         putStrLnM "skip"-         pure True-       else do-         let smt = assertPropsNoSimp conf [mkprop l r]-         res <- checkSat solvers smt-         print res-         pure $ case res of-           Unsat -> True-           EVM.Solvers.Unknown -> True-           Sat _ -> False-           Error _ -> False+checkEquivAndLHS :: (Typeable a, App m) => Expr a -> Expr a -> m Bool+checkEquivAndLHS orig simp = do+  opts <- readConfig+  let lhsConst =  Expr.checkLHSConst simp+  when (opts.debug) $ liftIO $ putStrLn $ "LHS const: " <> show lhsConst+  equiv <- checkEquiv orig simp+  pure $ lhsConst && equiv +checkEquivBase :: (Eq a, App m) => (a -> a -> Prop) -> a -> a -> Bool -> m (Maybe Bool)+checkEquivBase mkprop l r expect = do+  withSolvers Z3 1 1 (Just 1) $ \solvers -> liftIO $ do+     let smt = assertPropsNoSimp [mkprop l r]+     res <- checkSat solvers smt+     let+       ret = case res of+         Unsat -> Just True+         Sat _ -> Just False+         EVM.Solvers.Error _ -> Just (not expect)+         EVM.Solvers.Unknown _ -> Nothing+     when (ret == Just (not expect)) $ print res+     pure ret+ -- | Takes a runtime code and calls it with the provided calldata  -- | Takes a creation code and some calldata, runs the creation code, and calls the resulting contract with the provided calldata@@ -3572,7 +3857,7 @@  hex :: ByteString -> ByteString hex s =-  case BS16.decodeBase16 s of+  case BS16.decodeBase16Untyped s of     Right x -> x     Left e -> internalError $ T.unpack e @@ -3630,6 +3915,30 @@         _ -> internalError "AbiTuple expected"   in V.toList xy +-- abi types that are supported in the symbolic abi encoder+newtype SymbolicAbiType = SymbolicAbiType AbiType+  deriving (Eq, Show)++newtype SymbolicAbiVal = SymbolicAbiVal AbiValue+  deriving (Eq, Show)++instance Arbitrary SymbolicAbiVal where+  arbitrary = do+    SymbolicAbiType ty <- arbitrary+    SymbolicAbiVal <$> genAbiValue ty++instance Arbitrary SymbolicAbiType where+  arbitrary = SymbolicAbiType <$> frequency+    [ (5, (AbiUIntType . (* 8)) <$> choose (1, 32))+    , (5, (AbiIntType . (* 8)) <$> choose (1, 32))+    , (5, pure AbiAddressType)+    , (5, pure AbiBoolType)+    , (5, AbiBytesType <$> choose (1,32))+    , (1, do SymbolicAbiType ty <- scale (`div` 2) arbitrary+             AbiArrayType <$> (choose (1, 30)) <*> pure ty+      )+    ]+ newtype Bytes = Bytes ByteString   deriving Eq @@ -3739,7 +4048,8 @@   b <- defaultWord sz   n <- arbitrary   s <- genStorage sz-  pure $ C c s b n+  ts <- genStorage sz+  pure $ C {code=c, storage=s, tStorage=ts, balance=b, nonce=n}  -- ZeroDepthWord newtype ZeroDepthWord = ZeroDepthWord (Expr EWord)@@ -4020,7 +4330,7 @@     , fmap Keccak subBuf     , fmap SHA256 subBuf     , liftM2 SLoad subWord subStore-    , liftM2 ReadWord subWord subBuf+    , liftM2 ReadWord genReadIndex subBuf     , fmap BufLength subBuf     , do       one <- subByte@@ -4069,6 +4379,11 @@    subBuf = defaultBuf (sz `div` 10)    subStore = genStorage (sz `div` 10)    subByte = genByte (sz `div` 10)+   genReadIndex = do+    o :: (Expr EWord) <- subWord+    pure $ case o of+      Lit w -> Lit $ w `mod` into (maxBound :: Word64)+      _ -> o  genWordArith :: Int -> Int -> Gen (Expr EWord) genWordArith litFreq 0 = frequency@@ -4154,7 +4469,7 @@   --   - size > 100 (due to unrolling in SMT.hs)   --   - literal dstOffsets are > 4,000,000 (due to unrolling in SMT.hs)   -- n.b. that 4,000,000 is the theoretical maximum memory size given a 30,000,000 block gas limit-  , liftM5 CopySlice subWord (maybeBoundedLit bound) smolLitWord subBuf subBuf+  , liftM5 CopySlice genReadIndex (maybeBoundedLit bound) smolLitWord subBuf subBuf   ]   where     -- copySlice gets unrolled in the generated SMT so we can't go too crazy here@@ -4164,6 +4479,11 @@     subWord = defaultWord (sz `div` 5)     subByte = genByte (sz `div` 10)     subBuf = genBuf bound (sz `div` 10)+    genReadIndex = do+      o :: (Expr EWord) <- subWord+      pure $ case o of+        Lit w -> Lit $ w `mod` into (maxBound :: Word64)+        _ -> o  genStorage :: Int -> Gen (Expr Storage) genStorage 0 = oneof@@ -4179,7 +4499,7 @@ genStorageKey :: Gen (Expr EWord) genStorageKey = frequency      -- array slot-    [ (4, liftM2 Expr.ArraySlotWithOffset (genByteStringKey 32) (genSmallLit 5))+    [ (4, liftM2 Expr.ArraySlotWithOffs (genByteStringKey 32) (genSmallLit 5))     , (4, fmap Expr.ArraySlotZero (genByteStringKey 32))      -- mapping slot     , (8, liftM2 Expr.MappingSlot (genByteStringKey 64) (genSmallLit 5))@@ -4232,8 +4552,15 @@  checkBadCheatCode :: Text -> Postcondition s checkBadCheatCode sig _ = \case-  (Failure _ _ (BadCheatCode s)) -> (ConcreteBuf $ into s.unFunctionSelector) ./= (ConcreteBuf $ selector sig)+  (Failure _ c (Revert _)) -> case mapMaybe findBadCheatCode (concatMap flatten c.traces) of+    (s:_) -> (ConcreteBuf $ into s.unFunctionSelector) ./= (ConcreteBuf $ selector sig)+    _ -> PBool True   _ -> PBool True+  where+    findBadCheatCode :: Trace -> Maybe FunctionSelector+    findBadCheatCode Trace { tracedata = td } = case td of+      ErrorTrace (BadCheatCode _ s) -> Just s+      _ -> Nothing  allBranchesFail :: App m => ByteString -> Maybe Sig -> m (Either [SMTCex] (Expr End)) allBranchesFail = checkPost (Just p)@@ -4247,7 +4574,7 @@  checkPost :: App m => Maybe (Postcondition RealWorld) -> ByteString -> Maybe Sig -> m (Either [SMTCex] (Expr End)) checkPost post c sig = do-  (e, res) <- withSolvers Z3 1 Nothing $ \s ->+  (e, res) <- withDefaultSolver $ \s ->     verifyContract s c sig [] defaultVeriOpts Nothing post   let cexs = snd <$> mapMaybe getCex res   case cexs of@@ -4256,3 +4583,17 @@  successGen :: [Prop] -> Expr End successGen props = Success props mempty (ConcreteBuf "") mempty++-- gets the expected concrete values for symbolic abi testing+expectedConcVals :: Text -> AbiValue -> SMTCex+expectedConcVals nm val = case val of+  AbiUInt {} -> mempty { vars = Map.fromList [(Var nm, mkWord val)] }+  AbiInt {} -> mempty { vars = Map.fromList [(Var nm, mkWord val)] }+  AbiAddress {} -> mempty { addrs = Map.fromList [(SymAddr nm, truncateToAddr (mkWord val))] }+  AbiBool {} -> mempty { vars = Map.fromList [(Var nm, mkWord val)] }+  AbiBytes {} -> mempty { vars = Map.fromList [(Var nm, mkWord val)] }+  AbiArray _ _ vals -> mconcat . V.toList . V.imap (\(T.pack . show -> idx) v -> expectedConcVals (nm <> "-a-" <> idx) v) $ vals+  AbiTuple vals -> mconcat . V.toList . V.imap (\(T.pack . show -> idx) v -> expectedConcVals (nm <> "-t-" <> idx) v) $ vals+  _ -> internalError $ "unsupported Abi type " <> show nm <> " val: " <> show val <> " val type: " <> showAlter val+  where+    mkWord = word . encodeAbiValue