{-# Language ImplicitParams #-}
{-# Language DataKinds #-}
{-# Language GADTs #-}
{-# Language TemplateHaskell #-}

module EVM where

import Prelude hiding (log, exponent, GT, LT)

import EVM.ABI
import EVM.Concrete (createAddress, create2Address)
import EVM.Expr (readStorage, writeStorage, readByte, readWord, writeWord,
  writeByte, bufLength, indexWord, litAddr, readBytes, word256At, copySlice)
import EVM.Expr qualified as Expr
import EVM.FeeSchedule (FeeSchedule (..))
import EVM.Op
import EVM.Precompiled qualified
import EVM.Solidity
import EVM.Types hiding (IllegalOverflow, Error)
import EVM.Sign qualified

import Control.Lens hiding (op, (:<), (|>), (.>))
import Control.Monad.State.Strict hiding (state)
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.Lazy (fromStrict)
import Data.ByteString.Lazy qualified as LS
import Data.ByteString.Char8 qualified as Char8
import Data.Foldable (toList)
import Data.List (find)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe, fromJust)
import Data.Set (Set, insert, member, fromList)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (unpack)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Tree
import Data.Tree.Zipper qualified as Zipper
import Data.Tuple.Curry
import Data.Vector qualified as RegularVector
import Data.Vector qualified as V
import Data.Vector.Storable (Vector)
import Data.Vector.Storable qualified as Vector
import Data.Vector.Storable.Mutable qualified as Vector
import Data.Word (Word8, Word32, Word64)
import Options.Generic as Options

import Crypto.Hash (Digest, SHA256, RIPEMD160)
import Crypto.Hash qualified as Crypto
import Crypto.Number.ModArithmetic (expFast)
import Crypto.PubKey.ECC.ECDSA (signDigestWith, PrivateKey(..), Signature(..))

-- * Data types

-- | EVM failure modes
data Error
  = BalanceTooLow W256 W256
  | UnrecognizedOpcode Word8
  | SelfDestruction
  | StackUnderrun
  | BadJumpDestination
  | Revert (Expr Buf)
  | OutOfGas Word64 Word64
  | BadCheatCode (Maybe Word32)
  | StackLimitExceeded
  | IllegalOverflow
  | Query Query
  | Choose Choose
  | StateChangeWhileStatic
  | InvalidMemoryAccess
  | CallDepthLimitReached
  | MaxCodeSizeExceeded W256 W256
  | InvalidFormat
  | PrecompileFailure
  | forall a . UnexpectedSymbolicArg Int String [Expr a]
  | DeadPath
  | NotUnique (Expr EWord)
  | SMTTimeout
  | FFI [AbiValue]
  | ReturnDataOutOfBounds
  | NonceOverflow
deriving instance Show Error

-- | The possible result states of a VM
data VMResult
  = VMFailure Error -- ^ An operation failed
  | VMSuccess (Expr Buf) -- ^ Reached STOP, RETURN, or end-of-code

deriving instance Show VMResult

-- | The state of a stepwise EVM execution
data VM = VM
  { VM -> Maybe VMResult
_result         :: Maybe VMResult
  , VM -> FrameState
_state          :: FrameState
  , VM -> [Frame]
_frames         :: [Frame]
  , VM -> Env
_env            :: Env
  , VM -> Block
_block          :: Block
  , VM -> TxState
_tx             :: TxState
  , VM -> [Expr 'Log]
_logs           :: [Expr Log]
  , VM -> TreePos Empty Trace
_traces         :: Zipper.TreePos Zipper.Empty Trace
  , VM -> Cache
_cache          :: Cache
  , VM -> Word64
_burned         :: {-# UNPACK #-} !Word64
  , VM -> Map CodeLocation Int
_iterations     :: Map CodeLocation Int
  , VM -> [Prop]
_constraints    :: [Prop]
  , VM -> [Prop]
_keccakEqs      :: [Prop]
  , VM -> Bool
_allowFFI       :: Bool
  , VM -> Maybe (Expr 'EWord)
_overrideCaller :: Maybe (Expr EWord)
  }
  deriving (Int -> VM -> ShowS
[VM] -> ShowS
VM -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VM] -> ShowS
$cshowList :: [VM] -> ShowS
show :: VM -> String
$cshow :: VM -> String
showsPrec :: Int -> VM -> ShowS
$cshowsPrec :: Int -> VM -> ShowS
Show)

data Trace = Trace
  { Trace -> Int
_traceOpIx     :: Int
  , Trace -> Contract
_traceContract :: Contract
  , Trace -> TraceData
_traceData     :: TraceData
  }
  deriving (Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show)

data TraceData
  = EventTrace (Expr EWord) (Expr Buf) [Expr EWord]
  | FrameTrace FrameContext
  | QueryTrace Query
  | ErrorTrace Error
  | EntryTrace Text
  | ReturnTrace (Expr Buf) FrameContext
  deriving (Int -> TraceData -> ShowS
[TraceData] -> ShowS
TraceData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceData] -> ShowS
$cshowList :: [TraceData] -> ShowS
show :: TraceData -> String
$cshow :: TraceData -> String
showsPrec :: Int -> TraceData -> ShowS
$cshowsPrec :: Int -> TraceData -> ShowS
Show)

-- | Queries halt execution until resolved through RPC calls or SMT queries
data Query where
  PleaseFetchContract :: Addr -> (Contract -> EVM ()) -> Query
  --PleaseMakeUnique    :: SBV a -> [SBool] -> (IsUnique a -> EVM ()) -> Query
  PleaseFetchSlot     :: Addr -> W256 -> (W256 -> EVM ()) -> Query
  PleaseAskSMT        :: Expr EWord -> [Prop] -> (BranchCondition -> EVM ()) -> Query
  PleaseDoFFI         :: [String] -> (ByteString -> EVM ()) -> Query

data Choose where
  PleaseChoosePath    :: Expr EWord -> (Bool -> EVM ()) -> Choose

instance Show Query where
  showsPrec :: Int -> Query -> ShowS
showsPrec Int
_ = \case
    PleaseFetchContract Addr
addr Contract -> EVM ()
_ ->
      ((String
"<EVM.Query: fetch contract " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Addr
addr forall a. [a] -> [a] -> [a]
++ String
">") ++)
    PleaseFetchSlot Addr
addr W256
slot W256 -> EVM ()
_ ->
      ((String
"<EVM.Query: fetch slot "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show W256
slot forall a. [a] -> [a] -> [a]
++ String
" for "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Addr
addr forall a. [a] -> [a] -> [a]
++ String
">") ++)
    PleaseAskSMT Expr 'EWord
condition [Prop]
constraints BranchCondition -> EVM ()
_ ->
      ((String
"<EVM.Query: ask SMT about "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr 'EWord
condition forall a. [a] -> [a] -> [a]
++ String
" in context "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Prop]
constraints forall a. [a] -> [a] -> [a]
++ String
">") ++)
--     PleaseMakeUnique val constraints _ ->
--       (("<EVM.Query: make value "
--         ++ show val ++ " unique in context "
--         ++ show constraints ++ ">") ++)
    PleaseDoFFI [String]
cmd ByteString -> EVM ()
_ ->
      ((String
"<EVM.Query: do ffi: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show [String]
cmd)) ++)

instance Show Choose where
  showsPrec :: Int -> Choose -> ShowS
showsPrec Int
_ = \case
    PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
_ ->
      ((String
"<EVM.Choice: waiting for user to select path (0,1)") ++)

-- | Alias for the type of e.g. @exec1@.
type EVM a = State VM a

type CodeLocation = (Addr, Int)

-- | The possible return values of a SMT query
data BranchCondition = Case Bool | Unknown | Inconsistent
  deriving Int -> BranchCondition -> ShowS
[BranchCondition] -> ShowS
BranchCondition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BranchCondition] -> ShowS
$cshowList :: [BranchCondition] -> ShowS
show :: BranchCondition -> String
$cshow :: BranchCondition -> String
showsPrec :: Int -> BranchCondition -> ShowS
$cshowsPrec :: Int -> BranchCondition -> ShowS
Show

-- | The possible return values of a `is unique` SMT query
data IsUnique a = Unique a | Multiple | InconsistentU | TimeoutU
  deriving Int -> IsUnique a -> ShowS
forall a. Show a => Int -> IsUnique a -> ShowS
forall a. Show a => [IsUnique a] -> ShowS
forall a. Show a => IsUnique a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsUnique a] -> ShowS
$cshowList :: forall a. Show a => [IsUnique a] -> ShowS
show :: IsUnique a -> String
$cshow :: forall a. Show a => IsUnique a -> String
showsPrec :: Int -> IsUnique a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> IsUnique a -> ShowS
Show

-- | The cache is data that can be persisted for efficiency:
-- any expensive query that is constant at least within a block.
data Cache = Cache
  { Cache -> Map Addr Contract
_fetchedContracts :: Map Addr Contract,
    Cache -> Map W256 (Map W256 W256)
_fetchedStorage :: Map W256 (Map W256 W256),
    Cache -> Map (CodeLocation, Int) Bool
_path :: Map (CodeLocation, Int) Bool
  } deriving Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cache] -> ShowS
$cshowList :: [Cache] -> ShowS
show :: Cache -> String
$cshow :: Cache -> String
showsPrec :: Int -> Cache -> ShowS
$cshowsPrec :: Int -> Cache -> ShowS
Show

data StorageBase = Concrete | Symbolic
  deriving (Int -> StorageBase -> ShowS
[StorageBase] -> ShowS
StorageBase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageBase] -> ShowS
$cshowList :: [StorageBase] -> ShowS
show :: StorageBase -> String
$cshow :: StorageBase -> String
showsPrec :: Int -> StorageBase -> ShowS
$cshowsPrec :: Int -> StorageBase -> ShowS
Show, StorageBase -> StorageBase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageBase -> StorageBase -> Bool
$c/= :: StorageBase -> StorageBase -> Bool
== :: StorageBase -> StorageBase -> Bool
$c== :: StorageBase -> StorageBase -> Bool
Eq)

-- | A way to specify an initial VM state
data VMOpts = VMOpts
  { VMOpts -> Contract
vmoptContract :: Contract
  , VMOpts -> (Expr 'Buf, [Prop])
vmoptCalldata :: (Expr Buf, [Prop])
  , VMOpts -> StorageBase
vmoptStorageBase :: StorageBase
  , VMOpts -> Expr 'EWord
vmoptValue :: Expr EWord
  , VMOpts -> W256
vmoptPriorityFee :: W256
  , VMOpts -> Addr
vmoptAddress :: Addr
  , VMOpts -> Expr 'EWord
vmoptCaller :: Expr EWord
  , VMOpts -> Addr
vmoptOrigin :: Addr
  , VMOpts -> Word64
vmoptGas :: Word64
  , VMOpts -> Word64
vmoptGaslimit :: Word64
  , VMOpts -> W256
vmoptNumber :: W256
  , VMOpts -> Expr 'EWord
vmoptTimestamp :: Expr EWord
  , VMOpts -> Addr
vmoptCoinbase :: Addr
  , VMOpts -> W256
vmoptPrevRandao :: W256
  , VMOpts -> W256
vmoptMaxCodeSize :: W256
  , VMOpts -> Word64
vmoptBlockGaslimit :: Word64
  , VMOpts -> W256
vmoptGasprice :: W256
  , VMOpts -> W256
vmoptBaseFee :: W256
  , VMOpts -> FeeSchedule Word64
vmoptSchedule :: FeeSchedule Word64
  , VMOpts -> W256
vmoptChainId :: W256
  , VMOpts -> Bool
vmoptCreate :: Bool
  , VMOpts -> Map Addr [W256]
vmoptTxAccessList :: Map Addr [W256]
  , VMOpts -> Bool
vmoptAllowFFI :: Bool
  } deriving Int -> VMOpts -> ShowS
[VMOpts] -> ShowS
VMOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VMOpts] -> ShowS
$cshowList :: [VMOpts] -> ShowS
show :: VMOpts -> String
$cshow :: VMOpts -> String
showsPrec :: Int -> VMOpts -> ShowS
$cshowsPrec :: Int -> VMOpts -> ShowS
Show

-- | An entry in the VM's "call/create stack"
data Frame = Frame
  { Frame -> FrameContext
_frameContext   :: FrameContext
  , Frame -> FrameState
_frameState     :: FrameState
  }
  deriving (Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)

-- | Call/create info
data FrameContext
  = CreationContext
    { FrameContext -> Addr
creationContextAddress   :: Addr
    , FrameContext -> Expr 'EWord
creationContextCodehash  :: Expr EWord
    , FrameContext -> Map Addr Contract
creationContextReversion :: Map Addr Contract
    , FrameContext -> SubState
creationContextSubstate  :: SubState
    }
  | CallContext
    { FrameContext -> Addr
callContextTarget    :: Addr
    , FrameContext -> Addr
callContextContext   :: Addr
    , FrameContext -> W256
callContextOffset    :: W256
    , FrameContext -> W256
callContextSize      :: W256
    , FrameContext -> Expr 'EWord
callContextCodehash  :: Expr EWord
    , FrameContext -> Maybe W256
callContextAbi       :: Maybe W256
    , FrameContext -> Expr 'Buf
callContextData      :: Expr Buf
    , FrameContext -> (Map Addr Contract, Expr 'Storage)
callContextReversion :: (Map Addr Contract, Expr Storage)
    , FrameContext -> SubState
callContextSubState  :: SubState
    }
  deriving (Int -> FrameContext -> ShowS
[FrameContext] -> ShowS
FrameContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameContext] -> ShowS
$cshowList :: [FrameContext] -> ShowS
show :: FrameContext -> String
$cshow :: FrameContext -> String
showsPrec :: Int -> FrameContext -> ShowS
$cshowsPrec :: Int -> FrameContext -> ShowS
Show)

-- | The "registers" of the VM along with memory and data stack
data FrameState = FrameState
  { FrameState -> Addr
_contract     :: Addr
  , FrameState -> Addr
_codeContract :: Addr
  , FrameState -> ContractCode
_code         :: ContractCode
  , FrameState -> Int
_pc           :: {-# UNPACK #-} !Int
  , FrameState -> [Expr 'EWord]
_stack        :: [Expr EWord]
  , FrameState -> Expr 'Buf
_memory       :: Expr Buf
  , FrameState -> Word64
_memorySize   :: Word64
  , FrameState -> Expr 'Buf
_calldata     :: Expr Buf
  , FrameState -> Expr 'EWord
_callvalue    :: Expr EWord
  , FrameState -> Expr 'EWord
_caller       :: Expr EWord
  , FrameState -> Word64
_gas          :: {-# UNPACK #-} !Word64
  , FrameState -> Expr 'Buf
_returndata   :: Expr Buf
  , FrameState -> Bool
_static       :: Bool
  }
  deriving (Int -> FrameState -> ShowS
[FrameState] -> ShowS
FrameState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameState] -> ShowS
$cshowList :: [FrameState] -> ShowS
show :: FrameState -> String
$cshow :: FrameState -> String
showsPrec :: Int -> FrameState -> ShowS
$cshowsPrec :: Int -> FrameState -> ShowS
Show)

-- | The state that spans a whole transaction
data TxState = TxState
  { TxState -> W256
_gasprice            :: W256
  , TxState -> Word64
_txgaslimit          :: Word64
  , TxState -> W256
_txPriorityFee       :: W256
  , TxState -> Addr
_origin              :: Addr
  , TxState -> Addr
_toAddr              :: Addr
  , TxState -> Expr 'EWord
_value               :: Expr EWord
  , TxState -> SubState
_substate            :: SubState
  , TxState -> Bool
_isCreate            :: Bool
  , TxState -> Map Addr Contract
_txReversion         :: Map Addr Contract
  }
  deriving (Int -> TxState -> ShowS
[TxState] -> ShowS
TxState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxState] -> ShowS
$cshowList :: [TxState] -> ShowS
show :: TxState -> String
$cshow :: TxState -> String
showsPrec :: Int -> TxState -> ShowS
$cshowsPrec :: Int -> TxState -> ShowS
Show)

-- | The "accrued substate" across a transaction
data SubState = SubState
  { SubState -> [Addr]
_selfdestructs   :: [Addr]
  , SubState -> [Addr]
_touchedAccounts :: [Addr]
  , SubState -> Set Addr
_accessedAddresses :: Set Addr
  , SubState -> Set (Addr, W256)
_accessedStorageKeys :: Set (Addr, W256)
  , SubState -> [(Addr, Word64)]
_refunds         :: [(Addr, Word64)]
  -- in principle we should include logs here, but do not for now
  }
  deriving (Int -> SubState -> ShowS
[SubState] -> ShowS
SubState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubState] -> ShowS
$cshowList :: [SubState] -> ShowS
show :: SubState -> String
$cshow :: SubState -> String
showsPrec :: Int -> SubState -> ShowS
$cshowsPrec :: Int -> SubState -> ShowS
Show)

{- |
  A contract is either in creation (running its "constructor") or
  post-creation, and code in these two modes is treated differently
  by instructions like @EXTCODEHASH@, so we distinguish these two
  code types.

  The definition follows the structure of code output by solc. We need to use
  some heuristics here to deal with symbolic data regions that may be present
  in the bytecode since the fully abstract case is impractical:

  - initcode has concrete code, followed by an abstract data "section"
  - runtimecode has a fixed length, but may contain fixed size symbolic regions (due to immutable)

  hopefully we do not have to deal with dynamic immutable before we get a real data section...
-}
data ContractCode
  = InitCode ByteString (Expr Buf) -- ^ "Constructor" code, during contract creation
  | RuntimeCode RuntimeCode -- ^ "Instance" code, after contract creation
  deriving (Int -> ContractCode -> ShowS
[ContractCode] -> ShowS
ContractCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractCode] -> ShowS
$cshowList :: [ContractCode] -> ShowS
show :: ContractCode -> String
$cshow :: ContractCode -> String
showsPrec :: Int -> ContractCode -> ShowS
$cshowsPrec :: Int -> ContractCode -> ShowS
Show)

-- | We have two variants here to optimize the fully concrete case.
-- ConcreteRuntimeCode just wraps a ByteString
-- SymbolicRuntimeCode is a fixed length vector of potentially symbolic bytes, which lets us handle symbolic pushdata (e.g. from immutable variables in solidity).
data RuntimeCode
  = ConcreteRuntimeCode ByteString
  | SymbolicRuntimeCode (V.Vector (Expr Byte))
  deriving (Int -> RuntimeCode -> ShowS
[RuntimeCode] -> ShowS
RuntimeCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCode] -> ShowS
$cshowList :: [RuntimeCode] -> ShowS
show :: RuntimeCode -> String
$cshow :: RuntimeCode -> String
showsPrec :: Int -> RuntimeCode -> ShowS
$cshowsPrec :: Int -> RuntimeCode -> ShowS
Show, RuntimeCode -> RuntimeCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCode -> RuntimeCode -> Bool
$c/= :: RuntimeCode -> RuntimeCode -> Bool
== :: RuntimeCode -> RuntimeCode -> Bool
$c== :: RuntimeCode -> RuntimeCode -> Bool
Eq, Eq RuntimeCode
RuntimeCode -> RuntimeCode -> Bool
RuntimeCode -> RuntimeCode -> Ordering
RuntimeCode -> RuntimeCode -> RuntimeCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RuntimeCode -> RuntimeCode -> RuntimeCode
$cmin :: RuntimeCode -> RuntimeCode -> RuntimeCode
max :: RuntimeCode -> RuntimeCode -> RuntimeCode
$cmax :: RuntimeCode -> RuntimeCode -> RuntimeCode
>= :: RuntimeCode -> RuntimeCode -> Bool
$c>= :: RuntimeCode -> RuntimeCode -> Bool
> :: RuntimeCode -> RuntimeCode -> Bool
$c> :: RuntimeCode -> RuntimeCode -> Bool
<= :: RuntimeCode -> RuntimeCode -> Bool
$c<= :: RuntimeCode -> RuntimeCode -> Bool
< :: RuntimeCode -> RuntimeCode -> Bool
$c< :: RuntimeCode -> RuntimeCode -> Bool
compare :: RuntimeCode -> RuntimeCode -> Ordering
$ccompare :: RuntimeCode -> RuntimeCode -> Ordering
Ord)

-- runtime err when used for symbolic code
instance Eq ContractCode where
  (InitCode ByteString
a Expr 'Buf
b) == :: ContractCode -> ContractCode -> Bool
== (InitCode ByteString
c Expr 'Buf
d) = ByteString
a forall a. Eq a => a -> a -> Bool
== ByteString
c Bool -> Bool -> Bool
&& Expr 'Buf
b forall a. Eq a => a -> a -> Bool
== Expr 'Buf
d
  (RuntimeCode RuntimeCode
x) == (RuntimeCode RuntimeCode
y) = RuntimeCode
x forall a. Eq a => a -> a -> Bool
== RuntimeCode
y
  ContractCode
_ == ContractCode
_ = Bool
False

deriving instance Ord ContractCode

-- | A contract can either have concrete or symbolic storage
-- depending on what type of execution we are doing
-- data Storage
--   = Concrete (Map Word Expr EWord)
--   | Symbolic [(Expr EWord, Expr EWord)] (SArray (WordN 256) (WordN 256))
--   deriving (Show)

-- to allow for Eq Contract (which useful for debugging vmtests)
-- we mock an instance of Eq for symbolic storage.
-- It should not (cannot) be used though.
-- instance Eq Storage where
--   (==) (Concrete a) (Concrete b) = fmap forceLit a == fmap forceLit b
--   (==) (Symbolic _ _) (Concrete _) = False
--   (==) (Concrete _) (Symbolic _ _) = False
--   (==) _ _ = error "do not compare two symbolic arrays like this!"

-- | The state of a contract
data Contract = Contract
  { Contract -> ContractCode
_contractcode :: ContractCode
  , Contract -> W256
_balance      :: W256
  , Contract -> W256
_nonce        :: W256
  , Contract -> Expr 'EWord
_codehash     :: Expr EWord
  , Contract -> Vector Int
_opIxMap      :: Vector Int
  , Contract -> Vector (Int, Op)
_codeOps      :: RegularVector.Vector (Int, Op)
  , Contract -> Bool
_external     :: Bool
  }

deriving instance Show Contract

-- | When doing symbolic execution, we have three different
-- ways to model the storage of contracts. This determines
-- not only the initial contract storage model but also how
-- RPC or state fetched contracts will be modeled.
data StorageModel
  = ConcreteS    -- ^ Uses `Concrete` Storage. Reading / Writing from abstract
                 -- locations causes a runtime failure. Can be nicely combined with RPC.

  | SymbolicS    -- ^ Uses `Symbolic` Storage. Reading / Writing never reaches RPC,
                 -- but always done using an SMT array with no default value.

  | InitialS     -- ^ Uses `Symbolic` Storage. Reading / Writing never reaches RPC,
                 -- but always done using an SMT array with 0 as the default value.

  deriving (ReadPrec [StorageModel]
ReadPrec StorageModel
Int -> ReadS StorageModel
ReadS [StorageModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StorageModel]
$creadListPrec :: ReadPrec [StorageModel]
readPrec :: ReadPrec StorageModel
$creadPrec :: ReadPrec StorageModel
readList :: ReadS [StorageModel]
$creadList :: ReadS [StorageModel]
readsPrec :: Int -> ReadS StorageModel
$creadsPrec :: Int -> ReadS StorageModel
Read, Int -> StorageModel -> ShowS
[StorageModel] -> ShowS
StorageModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageModel] -> ShowS
$cshowList :: [StorageModel] -> ShowS
show :: StorageModel -> String
$cshow :: StorageModel -> String
showsPrec :: Int -> StorageModel -> ShowS
$cshowsPrec :: Int -> StorageModel -> ShowS
Show)

instance ParseField StorageModel

-- | Various environmental data
data Env = Env
  { Env -> Map Addr Contract
_contracts    :: Map Addr Contract
  , Env -> W256
_chainId      :: W256
  , Env -> Expr 'Storage
_storage      :: Expr Storage
  , Env -> Map W256 (Map W256 W256)
_origStorage  :: Map W256 (Map W256 W256)
  , Env -> Map W256 ByteString
_sha3Crack    :: Map W256 ByteString
  --, _keccakUsed   :: [([SWord 8], SWord 256)]
  }
  deriving (Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Env] -> ShowS
$cshowList :: [Env] -> ShowS
show :: Env -> String
$cshow :: Env -> String
showsPrec :: Int -> Env -> ShowS
$cshowsPrec :: Int -> Env -> ShowS
Show)


-- | Data about the block
data Block = Block
  { Block -> Addr
_coinbase    :: Addr
  , Block -> Expr 'EWord
_timestamp   :: Expr EWord
  , Block -> W256
_number      :: W256
  , Block -> W256
_prevRandao  :: W256
  , Block -> Word64
_gaslimit    :: Word64
  , Block -> W256
_baseFee     :: W256
  , Block -> W256
_maxCodeSize :: W256
  , Block -> FeeSchedule Word64
_schedule    :: FeeSchedule Word64
  } deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)


blankState :: FrameState
blankState :: FrameState
blankState = FrameState
  { $sel:_contract:FrameState :: Addr
_contract     = Addr
0
  , $sel:_codeContract:FrameState :: Addr
_codeContract = Addr
0
  , $sel:_code:FrameState :: ContractCode
_code         = RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
"")
  , $sel:_pc:FrameState :: Int
_pc           = Int
0
  , $sel:_stack:FrameState :: [Expr 'EWord]
_stack        = forall a. Monoid a => a
mempty
  , $sel:_memory:FrameState :: Expr 'Buf
_memory       = forall a. Monoid a => a
mempty
  , $sel:_memorySize:FrameState :: Word64
_memorySize   = Word64
0
  , $sel:_calldata:FrameState :: Expr 'Buf
_calldata     = forall a. Monoid a => a
mempty
  , $sel:_callvalue:FrameState :: Expr 'EWord
_callvalue    = (W256 -> Expr 'EWord
Lit W256
0)
  , $sel:_caller:FrameState :: Expr 'EWord
_caller       = (W256 -> Expr 'EWord
Lit W256
0)
  , $sel:_gas:FrameState :: Word64
_gas          = Word64
0
  , $sel:_returndata:FrameState :: Expr 'Buf
_returndata   = forall a. Monoid a => a
mempty
  , $sel:_static:FrameState :: Bool
_static       = Bool
False
  }

makeLenses ''FrameState
makeLenses ''Frame
makeLenses ''Block
makeLenses ''TxState
makeLenses ''SubState
makeLenses ''Contract
makeLenses ''Env
makeLenses ''Cache
makeLenses ''Trace
makeLenses ''VM

-- | An "external" view of a contract's bytecode, appropriate for
-- e.g. @EXTCODEHASH@.
bytecode :: Getter Contract (Expr Buf)
bytecode :: Getter Contract (Expr 'Buf)
bytecode = Lens' Contract ContractCode
contractcode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ContractCode -> Expr 'Buf
f
  where f :: ContractCode -> Expr 'Buf
f (InitCode ByteString
_ Expr 'Buf
_) = forall a. Monoid a => a
mempty
        f (RuntimeCode (ConcreteRuntimeCode ByteString
bs)) = ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
        f (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList Vector (Expr 'Byte)
ops

instance Semigroup Cache where
  Cache
a <> :: Cache -> Cache -> Cache
<> Cache
b = Cache
    { $sel:_fetchedContracts:Cache :: Map Addr Contract
_fetchedContracts = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Contract -> Contract -> Contract
unifyCachedContract Cache
a._fetchedContracts Cache
b._fetchedContracts
    , $sel:_fetchedStorage:Cache :: Map W256 (Map W256 W256)
_fetchedStorage = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map W256 W256 -> Map W256 W256 -> Map W256 W256
unifyCachedStorage Cache
a._fetchedStorage Cache
b._fetchedStorage
    , $sel:_path:Cache :: Map (CodeLocation, Int) Bool
_path = forall a. Monoid a => a -> a -> a
mappend Cache
a._path Cache
b._path
    }

unifyCachedStorage :: Map W256 W256 -> Map W256 W256 -> Map W256 W256
unifyCachedStorage :: Map W256 W256 -> Map W256 W256 -> Map W256 W256
unifyCachedStorage Map W256 W256
_ Map W256 W256
_ = forall a. HasCallStack => a
undefined

-- only intended for use in Cache merges, where we expect
-- everything to be Concrete
unifyCachedContract :: Contract -> Contract -> Contract
unifyCachedContract :: Contract -> Contract -> Contract
unifyCachedContract Contract
_ Contract
_ = forall a. HasCallStack => a
undefined
  {-
unifyCachedContract a b = a & set storage merged
  where merged = case (view storage a, view storage b) of
                   (ConcreteStore sa, ConcreteStore sb) ->
                     ConcreteStore (mappend sa sb)
                   _ ->
                     view storage a
   -}

instance Monoid Cache where
  mempty :: Cache
mempty = Cache { $sel:_fetchedContracts:Cache :: Map Addr Contract
_fetchedContracts = forall a. Monoid a => a
mempty,
                   $sel:_fetchedStorage:Cache :: Map W256 (Map W256 W256)
_fetchedStorage = forall a. Monoid a => a
mempty,
                   $sel:_path:Cache :: Map (CodeLocation, Int) Bool
_path = forall a. Monoid a => a
mempty
                 }

-- * Data accessors

currentContract :: VM -> Maybe Contract
currentContract :: VM -> Maybe Contract
currentContract VM
vm =
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VM
vm._state._codeContract VM
vm._env._contracts

-- * Data constructors

makeVm :: VMOpts -> VM
makeVm :: VMOpts -> VM
makeVm VMOpts
o =
  let txaccessList :: Map Addr [W256]
txaccessList = VMOpts
o.vmoptTxAccessList
      txorigin :: Addr
txorigin = VMOpts
o.vmoptOrigin
      txtoAddr :: Addr
txtoAddr = VMOpts
o.vmoptAddress
      initialAccessedAddrs :: Set Addr
initialAccessedAddrs = forall a. Ord a => [a] -> Set a
fromList forall a b. (a -> b) -> a -> b
$ [Addr
txorigin, Addr
txtoAddr] forall a. [a] -> [a] -> [a]
++ [Addr
1..Addr
9] forall a. [a] -> [a] -> [a]
++ (forall k a. Map k a -> [k]
Map.keys Map Addr [W256]
txaccessList)
      initialAccessedStorageKeys :: Set (Addr, W256)
initialAccessedStorageKeys = forall a. Ord a => [a] -> Set a
fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))) (forall k a. Map k a -> [(k, a)]
Map.toList Map Addr [W256]
txaccessList)
      touched :: [Addr]
touched = if VMOpts
o.vmoptCreate then [Addr
txorigin] else [Addr
txorigin, Addr
txtoAddr]
  in
  VM
  { $sel:_result:VM :: Maybe VMResult
_result = forall a. Maybe a
Nothing
  , $sel:_frames:VM :: [Frame]
_frames = forall a. Monoid a => a
mempty
  , $sel:_tx:VM :: TxState
_tx = TxState
    { $sel:_gasprice:TxState :: W256
_gasprice = VMOpts
o.vmoptGasprice
    , $sel:_txgaslimit:TxState :: Word64
_txgaslimit = VMOpts
o.vmoptGaslimit
    , $sel:_txPriorityFee:TxState :: W256
_txPriorityFee = VMOpts
o.vmoptPriorityFee
    , $sel:_origin:TxState :: Addr
_origin = Addr
txorigin
    , $sel:_toAddr:TxState :: Addr
_toAddr = Addr
txtoAddr
    , $sel:_value:TxState :: Expr 'EWord
_value = VMOpts
o.vmoptValue
    , $sel:_substate:TxState :: SubState
_substate = [Addr]
-> [Addr]
-> Set Addr
-> Set (Addr, W256)
-> [(Addr, Word64)]
-> SubState
SubState forall a. Monoid a => a
mempty [Addr]
touched Set Addr
initialAccessedAddrs Set (Addr, W256)
initialAccessedStorageKeys forall a. Monoid a => a
mempty
    --, _accessList = txaccessList
    , $sel:_isCreate:TxState :: Bool
_isCreate = VMOpts
o.vmoptCreate
    , $sel:_txReversion:TxState :: Map Addr Contract
_txReversion = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(VMOpts
o.vmoptAddress , VMOpts
o.vmoptContract )]
    }
  , $sel:_logs:VM :: [Expr 'Log]
_logs = []
  , $sel:_traces:VM :: TreePos Empty Trace
_traces = forall a. Forest a -> TreePos Empty a
Zipper.fromForest []
  , $sel:_block:VM :: Block
_block = Block
    { $sel:_coinbase:Block :: Addr
_coinbase = VMOpts
o.vmoptCoinbase
    , $sel:_timestamp:Block :: Expr 'EWord
_timestamp = VMOpts
o.vmoptTimestamp
    , $sel:_number:Block :: W256
_number = VMOpts
o.vmoptNumber
    , $sel:_prevRandao:Block :: W256
_prevRandao = VMOpts
o.vmoptPrevRandao
    , $sel:_maxCodeSize:Block :: W256
_maxCodeSize = VMOpts
o.vmoptMaxCodeSize
    , $sel:_gaslimit:Block :: Word64
_gaslimit = VMOpts
o.vmoptBlockGaslimit
    , $sel:_baseFee:Block :: W256
_baseFee = VMOpts
o.vmoptBaseFee
    , $sel:_schedule:Block :: FeeSchedule Word64
_schedule = VMOpts
o.vmoptSchedule
    }
  , $sel:_state:VM :: FrameState
_state = FrameState
    { $sel:_pc:FrameState :: Int
_pc = Int
0
    , $sel:_stack:FrameState :: [Expr 'EWord]
_stack = forall a. Monoid a => a
mempty
    , $sel:_memory:FrameState :: Expr 'Buf
_memory = forall a. Monoid a => a
mempty
    , $sel:_memorySize:FrameState :: Word64
_memorySize = Word64
0
    , $sel:_code:FrameState :: ContractCode
_code = VMOpts
o.vmoptContract._contractcode
    , $sel:_contract:FrameState :: Addr
_contract = VMOpts
o.vmoptAddress
    , $sel:_codeContract:FrameState :: Addr
_codeContract = VMOpts
o.vmoptAddress
    , $sel:_calldata:FrameState :: Expr 'Buf
_calldata = forall a b. (a, b) -> a
fst VMOpts
o.vmoptCalldata
    , $sel:_callvalue:FrameState :: Expr 'EWord
_callvalue = VMOpts
o.vmoptValue
    , $sel:_caller:FrameState :: Expr 'EWord
_caller = VMOpts
o.vmoptCaller
    , $sel:_gas:FrameState :: Word64
_gas = VMOpts
o.vmoptGas
    , $sel:_returndata:FrameState :: Expr 'Buf
_returndata = forall a. Monoid a => a
mempty
    , $sel:_static:FrameState :: Bool
_static = Bool
False
    }
  , $sel:_env:VM :: Env
_env = Env
    { $sel:_sha3Crack:Env :: Map W256 ByteString
_sha3Crack = forall a. Monoid a => a
mempty
    , $sel:_chainId:Env :: W256
_chainId = VMOpts
o.vmoptChainId
    , $sel:_storage:Env :: Expr 'Storage
_storage = if VMOpts
o.vmoptStorageBase forall a. Eq a => a -> a -> Bool
== StorageBase
Concrete then Expr 'Storage
EmptyStore else Expr 'Storage
AbstractStore
    , $sel:_origStorage:Env :: Map W256 (Map W256 W256)
_origStorage = forall a. Monoid a => a
mempty
    , $sel:_contracts:Env :: Map Addr Contract
_contracts = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(VMOpts
o.vmoptAddress, VMOpts
o.vmoptContract )]
    --, _keccakUsed = mempty
    --, _storageModel = vmoptStorageModel o
    }
  , $sel:_cache:VM :: Cache
_cache = Map Addr Contract
-> Map W256 (Map W256 W256)
-> Map (CodeLocation, Int) Bool
-> Cache
Cache forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
  , $sel:_burned:VM :: Word64
_burned = Word64
0
  , $sel:_constraints:VM :: [Prop]
_constraints = forall a b. (a, b) -> b
snd VMOpts
o.vmoptCalldata
  , $sel:_keccakEqs:VM :: [Prop]
_keccakEqs = forall a. Monoid a => a
mempty
  , $sel:_iterations:VM :: Map CodeLocation Int
_iterations = forall a. Monoid a => a
mempty
  , $sel:_allowFFI:VM :: Bool
_allowFFI = VMOpts
o.vmoptAllowFFI
  , $sel:_overrideCaller:VM :: Maybe (Expr 'EWord)
_overrideCaller = forall a. Maybe a
Nothing
  }

-- | Initialize empty contract with given code
initialContract :: ContractCode -> Contract
initialContract :: ContractCode -> Contract
initialContract ContractCode
theContractCode = Contract
  { $sel:_contractcode:Contract :: ContractCode
_contractcode = ContractCode
theContractCode
  , $sel:_codehash:Contract :: Expr 'EWord
_codehash = ContractCode -> Expr 'EWord
hashcode ContractCode
theContractCode
  , $sel:_balance:Contract :: W256
_balance  = W256
0
  , $sel:_nonce:Contract :: W256
_nonce    = if Bool
creation then W256
1 else W256
0
  , $sel:_opIxMap:Contract :: Vector Int
_opIxMap  = ContractCode -> Vector Int
mkOpIxMap ContractCode
theContractCode
  , $sel:_codeOps:Contract :: Vector (Int, Op)
_codeOps  = ContractCode -> Vector (Int, Op)
mkCodeOps ContractCode
theContractCode
  , $sel:_external:Contract :: Bool
_external = Bool
False
  } where
      creation :: Bool
creation = case ContractCode
theContractCode of
        InitCode ByteString
_ Expr 'Buf
_  -> Bool
True
        RuntimeCode RuntimeCode
_ -> Bool
False

-- * Opcode dispatch (exec1)

-- | Update program counter
next :: (?op :: Word8) => EVM ()
next :: (?op::Word8) => EVM ()
next = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Int
pc) (forall a. Num a => a -> a -> a
+ (Word8 -> Int
opSize ?op::Word8
?op))

-- | Executes the EVM one step
exec1 :: EVM ()
exec1 :: EVM ()
exec1 = do
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get

  let
    -- Convenient aliases
    mem :: Expr 'Buf
mem  = VM
vm._state._memory
    stk :: [Expr 'EWord]
stk  = VM
vm._state._stack
    self :: Addr
self = VM
vm._state._contract
    this :: Contract
this = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"internal error: state contract") (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
self VM
vm._env._contracts)

    fees :: FeeSchedule Word64
fees@FeeSchedule {Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
..} = VM
vm._block._schedule

    doStop :: EVM ()
doStop = FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned forall a. Monoid a => a
mempty)

  if Addr
self forall a. Ord a => a -> a -> Bool
> Addr
0x0 Bool -> Bool -> Bool
&& Addr
self forall a. Ord a => a -> a -> Bool
<= Addr
0x9 then do
    -- call to precompile
    let ?op = Word8
0x00 -- dummy value
    case Expr 'Buf -> Expr 'EWord
bufLength VM
vm._state._calldata of
      (Lit W256
calldatasize) -> do
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm._state._calldata (W256 -> Expr 'EWord
Lit W256
calldatasize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
0)
          (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
self VM
vm._state._gas W256
0 W256
calldatasize W256
0 W256
0 []
          VM
vmx <- forall s (m :: * -> *). MonadState s m => m s
get
          case VM
vmx._state._stack of
            (Expr 'EWord
x:[Expr 'EWord]
_) -> case Expr 'EWord
x of
              Lit (forall a b. (Integral a, Num b) => a -> b
num -> Integer
x' :: Integer) -> case Integer
x' of
                Integer
0 -> do
                  Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
self forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                    Addr -> EVM ()
touchAccount Addr
self
                    Error -> EVM ()
vmError Error
PrecompileFailure
                Integer
_ -> Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
self forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                    Addr -> EVM ()
touchAccount Addr
self
                    Expr 'Buf
out <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata)
                    FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
out)
              Expr 'EWord
e -> Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$
                forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vmx._state._pc String
"precompile returned a symbolic value" [Expr 'EWord
e]
            [Expr 'EWord]
_ ->
              EVM ()
underrun
      Expr 'EWord
e -> Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
"cannot call precompiles with symbolic data" [Expr 'EWord
e]

  else if VM
vm._state._pc forall a. Ord a => a -> a -> Bool
>= ContractCode -> Int
opslen VM
vm._state._code
    then EVM ()
doStop

    else do
      let ?op = case VM
vm._state._code of
                  InitCode ByteString
conc Expr 'Buf
_ -> HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
conc VM
vm._state._pc
                  RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
bs VM
vm._state._pc
                  RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
                    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"could not analyze symbolic code") forall a b. (a -> b) -> a -> b
$
                      Expr 'Byte -> Maybe Word8
unlitByte forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops forall a. Vector a -> Int -> a
V.! VM
vm._state._pc

      case Word8 -> GenericOp Word8
getOp(?op::Word8
?op) of

        OpPush Word8
n' -> do
          let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n'
              !xs :: Expr 'EWord
xs = case VM
vm._state._code of
                InitCode ByteString
conc Expr 'Buf
_ -> W256 -> Expr 'EWord
Lit forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
padRight Int
n forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (Int -> ByteString -> ByteString
BS.drop (Int
1 forall a. Num a => a -> a -> a
+ VM
vm._state._pc) ByteString
conc)
                RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> W256 -> Expr 'EWord
Lit forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
1 forall a. Num a => a -> a -> a
+ VM
vm._state._pc) ByteString
bs
                RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
                  let bytes :: Vector (Expr 'Byte)
bytes = forall a. Int -> Vector a -> Vector a
V.take Int
n forall a b. (a -> b) -> a -> b
$ forall a. Int -> Vector a -> Vector a
V.drop (Int
1 forall a. Num a => a -> a -> a
+ VM
vm._state._pc) Vector (Expr 'Byte)
ops
                  in Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
0) forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
padLeft' Int
32 Vector (Expr 'Byte)
bytes
          Int -> EVM () -> EVM ()
limitStack Int
1 forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall a b. (a -> b) -> a -> b
$ do
              (?op::Word8) => EVM ()
next
              Expr 'EWord -> EVM ()
pushSym Expr 'EWord
xs

        OpDup Word8
i ->
          case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i forall a. Num a => a -> a -> a
- Index [Expr 'EWord]
1)) [Expr 'EWord]
stk of
            Maybe (Expr 'EWord)
Nothing -> EVM ()
underrun
            Just Expr 'EWord
y ->
              Int -> EVM () -> EVM ()
limitStack Int
1 forall a b. (a -> b) -> a -> b
$
                Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall a b. (a -> b) -> a -> b
$ do
                  (?op::Word8) => EVM ()
next
                  Expr 'EWord -> EVM ()
pushSym Expr 'EWord
y

        OpSwap Word8
i ->
          if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
stk forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i) forall a. Num a => a -> a -> a
+ Int
1
            then EVM ()
underrun
            else
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall a b. (a -> b) -> a -> b
$ do
                (?op::Word8) => EVM ()
next
                forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) forall a b. (a -> b) -> a -> b
$ do
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [Expr 'EWord]
0) ([Expr 'EWord]
stk forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i))
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)) ([Expr 'EWord]
stk forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0)

        OpLog Word8
n ->
          EVM () -> EVM ()
notStatic forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
xs) ->
              if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
xs forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)
              then EVM ()
underrun
              else
                (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xOffset', Expr 'EWord
xSize') String
"LOG" forall a b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) -> do
                    let ([Expr 'EWord]
topics, [Expr 'EWord]
xs') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) [Expr 'EWord]
xs
                        bytes :: Expr 'Buf
bytes         = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                        logs' :: [Expr 'Log]
logs'         = (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> Expr 'Log
LogEntry (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'Buf
bytes [Expr 'EWord]
topics) forall a. a -> [a] -> [a]
: VM
vm._logs
                    Word64 -> EVM () -> EVM ()
burn (Word64
g_log forall a. Num a => a -> a -> a
+ Word64
g_logdata forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
num W256
xSize) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
num Word8
n forall a. Num a => a -> a -> a
* Word64
g_logtopic) forall a b. (a -> b) -> a -> b
$
                      W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall a b. (a -> b) -> a -> b
$ do
                        [Expr 'Log] -> EVM ()
traceTopLog [Expr 'Log]
logs'
                        (?op::Word8) => EVM ()
next
                        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs'
                        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM [Expr 'Log]
logs [Expr 'Log]
logs'
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpStop -> EVM ()
doStop

        GenericOp Word8
OpAdd -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add)
        GenericOp Word8
OpMul -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mul)
        GenericOp Word8
OpSub -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sub)

        GenericOp Word8
OpDiv -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.div)

        GenericOp Word8
OpSdiv -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sdiv)

        GenericOp Word8
OpMod-> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mod)

        GenericOp Word8
OpSmod -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.smod)
        GenericOp Word8
OpAddmod -> (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
g_mid (forall a b. Curry a b => b -> a
uncurryN Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.addmod)
        GenericOp Word8
OpMulmod -> (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
g_mid (forall a b. Curry a b => b -> a
uncurryN Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mulmod)

        GenericOp Word8
OpLt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt)
        GenericOp Word8
OpGt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt)
        GenericOp Word8
OpSlt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.slt)
        GenericOp Word8
OpSgt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sgt)

        GenericOp Word8
OpEq -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.eq)
        GenericOp Word8
OpIszero -> (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_verylow Expr 'EWord -> Expr 'EWord
Expr.iszero

        GenericOp Word8
OpAnd -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.and)
        GenericOp Word8
OpOr -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.or)
        GenericOp Word8
OpXor -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.xor)
        GenericOp Word8
OpNot -> (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_verylow Expr 'EWord -> Expr 'EWord
Expr.not

        GenericOp Word8
OpByte -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (\(Expr 'EWord
i, Expr 'EWord
w) -> Expr 'Byte -> Expr 'EWord
Expr.padByte forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> Expr 'Byte
Expr.indexWord Expr 'EWord
i Expr 'EWord
w)

        GenericOp Word8
OpShl -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.shl)
        GenericOp Word8
OpShr -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.shr)
        GenericOp Word8
OpSar -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sar)

        -- more accurately refered to as KECCAK
        GenericOp Word8
OpSha3 ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xOffset' : Expr 'EWord
xSize' : [Expr 'EWord]
xs) ->
              Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
xOffset' String
"sha3 offset must be concrete" forall a b. (a -> b) -> a -> b
$
                \W256
xOffset -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
xSize' String
"sha3 size must be concrete" forall a b. (a -> b) -> a -> b
$ \W256
xSize ->
                  Word64 -> EVM () -> EVM ()
burn (Word64
g_sha3 forall a. Num a => a -> a -> a
+ Word64
g_sha3word forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num W256
xSize) Word64
32) forall a b. (a -> b) -> a -> b
$
                    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall a b. (a -> b) -> a -> b
$ do
                      (Expr 'EWord
hash, Map W256 ByteString
invMap) <- case Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm of
                                          ConcreteBuf ByteString
bs -> do
                                            let hash' :: W256
hash' = ByteString -> W256
keccak' ByteString
bs
                                            [Prop]
eqs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' VM [Prop]
keccakEqs
                                            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM [Prop]
keccakEqs forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
PEq (W256 -> Expr 'EWord
Lit W256
hash') (Expr 'Buf -> Expr 'EWord
Keccak (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs))forall a. a -> [a] -> [a]
:[Prop]
eqs
                                            forall (f :: * -> *) a. Applicative f => a -> f a
pure (W256 -> Expr 'EWord
Lit W256
hash', forall k a. k -> a -> Map k a
Map.singleton W256
hash' ByteString
bs)
                                          Expr 'Buf
buf -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'Buf -> Expr 'EWord
Keccak Expr 'Buf
buf, forall a. Monoid a => a
mempty)
                      (?op::Word8) => EVM ()
next
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (Expr 'EWord
hash forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                      (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map W256 ByteString)
sha3Crack) forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Map W256 ByteString
invMap
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpAddress ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM () -> EVM ()
burn Word64
g_base ((?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num Addr
self))

        GenericOp Word8
OpBalance ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x':[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' String
"BALANCE" forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Addr -> EVM () -> EVM ()
accessAndBurn (forall a b. (Integral a, Num b) => a -> b
num W256
x) forall a b. (a -> b) -> a -> b
$
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall a b. (Integral a, Num b) => a -> b
num W256
x) forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                  (?op::Word8) => EVM ()
next
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                  W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num Contract
c._balance)
            [] ->
              EVM ()
underrun

        GenericOp Word8
OpOrigin ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num VM
vm._tx._origin)

        GenericOp Word8
OpCaller ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym VM
vm._state._caller

        GenericOp Word8
OpCallvalue ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym VM
vm._state._callvalue

        GenericOp Word8
OpCalldataload -> (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_verylow forall a b. (a -> b) -> a -> b
$
          \Expr 'EWord
ind -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
Expr.readWord Expr 'EWord
ind VM
vm._state._calldata

        GenericOp Word8
OpCalldatasize ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength VM
vm._state._calldata)

        GenericOp Word8
OpCalldatacopy ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xTo' : Expr 'EWord
xFrom : Expr 'EWord
xSize' : [Expr 'EWord]
xs) ->
              (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xTo', Expr 'EWord
xSize') String
"CALLDATACOPY" forall a b. (a -> b) -> a -> b
$
                \(W256
xTo, W256
xSize) ->
                  Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow forall a. Num a => a -> a -> a
+ Word64
g_copy forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num W256
xSize) Word64
32) forall a b. (a -> b) -> a -> b
$
                    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xTo W256
xSize forall a b. (a -> b) -> a -> b
$ do
                      (?op::Word8) => EVM ()
next
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                      Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm._state._calldata Expr 'EWord
xSize' Expr 'EWord
xFrom Expr 'EWord
xTo'
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpCodesize ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym (ContractCode -> Expr 'EWord
codelen VM
vm._state._code)

        GenericOp Word8
OpCodecopy ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
memOffset' : Expr 'EWord
codeOffset : Expr 'EWord
n' : [Expr 'EWord]
xs) ->
              (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
memOffset', Expr 'EWord
n') String
"CODECOPY" forall a b. (a -> b) -> a -> b
$
                \(W256
memOffset,W256
n) -> do
                  case W256 -> Maybe Word64
toWord64 W256
n of
                    Maybe Word64
Nothing -> Error -> EVM ()
vmError Error
IllegalOverflow
                    Just Word64
n'' ->
                      if Word64
n'' forall a. Ord a => a -> a -> Bool
<= ( (forall a. Bounded a => a
maxBound :: Word64) forall a. Num a => a -> a -> a
- Word64
g_verylow ) forall a. Integral a => a -> a -> a
`div` Word64
g_copy forall a. Num a => a -> a -> a
* Word64
32 then
                        Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow forall a. Num a => a -> a -> a
+ Word64
g_copy forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num W256
n) Word64
32) forall a b. (a -> b) -> a -> b
$
                          W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
memOffset W256
n forall a b. (a -> b) -> a -> b
$ do
                            (?op::Word8) => EVM ()
next
                            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ContractCode -> Expr 'Buf
toBuf VM
vm._state._code) Expr 'EWord
n' Expr 'EWord
codeOffset Expr 'EWord
memOffset'
                      else Error -> EVM ()
vmError Error
IllegalOverflow
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpGasprice ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm._tx._gasprice

        GenericOp Word8
OpExtcodesize ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x':[Expr 'EWord]
xs) -> case Expr 'EWord
x' of
              (Lit W256
x) -> if W256
x forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
num Addr
cheatCode
                then do
                  (?op::Word8) => EVM ()
next
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                  Expr 'EWord -> EVM ()
pushSym (W256 -> Expr 'EWord
Lit W256
1)
                else
                  Addr -> EVM () -> EVM ()
accessAndBurn (forall a b. (Integral a, Num b) => a -> b
num W256
x) forall a b. (a -> b) -> a -> b
$
                    Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall a b. (Integral a, Num b) => a -> b
num W256
x) forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                      (?op::Word8) => EVM ()
next
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                      Expr 'EWord -> EVM ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Contract (Expr 'Buf)
bytecode Contract
c))
              Expr 'EWord
_ -> do
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                Expr 'EWord -> EVM ()
pushSym (Expr 'EWord -> Expr 'EWord
CodeSize Expr 'EWord
x')
                (?op::Word8) => EVM ()
next
            [] ->
              EVM ()
underrun

        GenericOp Word8
OpExtcodecopy ->
          case [Expr 'EWord]
stk of
            ( Expr 'EWord
extAccount'
              : Expr 'EWord
memOffset'
              : Expr 'EWord
codeOffset
              : Expr 'EWord
codeSize'
              : [Expr 'EWord]
xs ) ->
              (Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
extAccount', Expr 'EWord
memOffset', Expr 'EWord
codeSize') String
"EXTCODECOPY" forall a b. (a -> b) -> a -> b
$
                \(W256
extAccount, W256
memOffset, W256
codeSize) -> do
                  Bool
acc <- Addr -> EVM Bool
accessAccountForGas (forall a b. (Integral a, Num b) => a -> b
num W256
extAccount)
                  let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
                  Word64 -> EVM () -> EVM ()
burn (Word64
cost forall a. Num a => a -> a -> a
+ Word64
g_copy forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num W256
codeSize) Word64
32) forall a b. (a -> b) -> a -> b
$
                    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
memOffset W256
codeSize forall a b. (a -> b) -> a -> b
$
                      Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall a b. (Integral a, Num b) => a -> b
num W256
extAccount) forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                        (?op::Word8) => EVM ()
next
                        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                        Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Contract (Expr 'Buf)
bytecode Contract
c) Expr 'EWord
codeSize' Expr 'EWord
codeOffset Expr 'EWord
memOffset'
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpReturndatasize ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength VM
vm._state._returndata)

        GenericOp Word8
OpReturndatacopy ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xTo' : Expr 'EWord
xFrom : Expr 'EWord
xSize' :[Expr 'EWord]
xs) -> (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xTo', Expr 'EWord
xSize') String
"RETURNDATACOPY" forall a b. (a -> b) -> a -> b
$
              \(W256
xTo, W256
xSize) ->
                Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow forall a. Num a => a -> a -> a
+ Word64
g_copy forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num W256
xSize) Word64
32) forall a b. (a -> b) -> a -> b
$
                  W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xTo W256
xSize forall a b. (a -> b) -> a -> b
$ do
                    (?op::Word8) => EVM ()
next
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs

                    let jump :: Bool -> EVM ()
jump Bool
True = Error -> EVM ()
vmError Error
EVM.ReturnDataOutOfBounds
                        jump Bool
False = Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm._state._returndata Expr 'EWord
xSize' Expr 'EWord
xFrom Expr 'EWord
xTo'

                    case (Expr 'EWord
xFrom, Expr 'Buf -> Expr 'EWord
bufLength VM
vm._state._returndata) of
                      (Lit W256
f, Lit W256
l) ->
                        Bool -> EVM ()
jump forall a b. (a -> b) -> a -> b
$ W256
l forall a. Ord a => a -> a -> Bool
< W256
f forall a. Num a => a -> a -> a
+ W256
xSize Bool -> Bool -> Bool
|| W256
f forall a. Num a => a -> a -> a
+ W256
xSize forall a. Ord a => a -> a -> Bool
< W256
f
                      (Expr 'EWord, Expr 'EWord)
_ -> do
                        let oob :: Expr 'EWord
oob = Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt (Expr 'Buf -> Expr 'EWord
bufLength VM
vm._state._returndata) (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add Expr 'EWord
xFrom Expr 'EWord
xSize')
                            overflow :: Expr 'EWord
overflow = Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add Expr 'EWord
xFrom Expr 'EWord
xSize') (Expr 'EWord
xFrom)
                        CodeLocation
loc <- EVM CodeLocation
codeloc
                        CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.or Expr 'EWord
oob Expr 'EWord
overflow) Bool -> EVM ()
jump
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpExtcodehash ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x':[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' String
"EXTCODEHASH" forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Addr -> EVM () -> EVM ()
accessAndBurn (forall a b. (Integral a, Num b) => a -> b
num W256
x) forall a b. (a -> b) -> a -> b
$ do
                (?op::Word8) => EVM ()
next
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall a b. (Integral a, Num b) => a -> b
num W256
x) forall a b. (a -> b) -> a -> b
$ \Contract
c ->
                   if Contract -> Bool
accountEmpty Contract
c
                     then W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num (Int
0 :: Int))
                     else Expr 'EWord -> EVM ()
pushSym forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
keccak (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Contract (Expr 'Buf)
bytecode Contract
c)
            [] ->
              EVM ()
underrun

        GenericOp Word8
OpBlockhash -> do
          -- We adopt the fake block hash scheme of the VMTests,
          -- so that blockhash(i) is the hash of i as decimal ASCII.
          (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_blockhash forall a b. (a -> b) -> a -> b
$ \case
            (Lit W256
i) -> if W256
i forall a. Num a => a -> a -> a
+ W256
256 forall a. Ord a => a -> a -> Bool
< VM
vm._block._number Bool -> Bool -> Bool
|| W256
i forall a. Ord a => a -> a -> Bool
>= VM
vm._block._number
                       then W256 -> Expr 'EWord
Lit W256
0
                       else (forall a b. (Integral a, Num b) => a -> b
num W256
i :: Integer) forall a b. a -> (a -> b) -> b
& forall a. Show a => a -> String
show forall a b. a -> (a -> b) -> b
& String -> ByteString
Char8.pack forall a b. a -> (a -> b) -> b
& ByteString -> W256
keccak' forall a b. a -> (a -> b) -> b
& W256 -> Expr 'EWord
Lit
            Expr 'EWord
i -> Expr 'EWord -> Expr 'EWord
BlockHash Expr 'EWord
i

        GenericOp Word8
OpCoinbase ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num VM
vm._block._coinbase)

        GenericOp Word8
OpTimestamp ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym VM
vm._block._timestamp

        GenericOp Word8
OpNumber ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm._block._number

        GenericOp Word8
OpPrevRandao -> do
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm._block._prevRandao

        GenericOp Word8
OpGaslimit ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num VM
vm._block._gaslimit)

        GenericOp Word8
OpChainid ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm._env._chainId

        GenericOp Word8
OpSelfbalance ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_low forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push Contract
this._balance

        GenericOp Word8
OpBaseFee ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm._block._baseFee

        GenericOp Word8
OpPop ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
_:[Expr 'EWord]
xs) -> Word64 -> EVM () -> EVM ()
burn Word64
g_base ((?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs)
            [Expr 'EWord]
_      -> EVM ()
underrun

        GenericOp Word8
OpMload ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x':[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' String
"MLOAD" forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall a b. (a -> b) -> a -> b
$
                W256 -> EVM () -> EVM ()
accessMemoryWord W256
x forall a b. (a -> b) -> a -> b
$ do
                  (?op::Word8) => EVM ()
next
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
x) Expr 'Buf
mem forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpMstore ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x':Expr 'EWord
y:[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' String
"MSTORE index" forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall a b. (a -> b) -> a -> b
$
                W256 -> EVM () -> EVM ()
accessMemoryWord W256
x forall a b. (a -> b) -> a -> b
$ do
                  (?op::Word8) => EVM ()
next
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory) (Expr 'EWord -> Expr 'EWord -> Expr 'Buf -> Expr 'Buf
writeWord (W256 -> Expr 'EWord
Lit W256
x) Expr 'EWord
y Expr 'Buf
mem)
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpMstore8 ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x':Expr 'EWord
y:[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' String
"MSTORE8" forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall a b. (a -> b) -> a -> b
$
                W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
x W256
1 forall a b. (a -> b) -> a -> b
$ do
                  let yByte :: Expr 'Byte
yByte = Expr 'EWord -> Expr 'EWord -> Expr 'Byte
indexWord (W256 -> Expr 'EWord
Lit W256
31) Expr 'EWord
y
                  (?op::Word8) => EVM ()
next
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory) (Expr 'EWord -> Expr 'Byte -> Expr 'Buf -> Expr 'Buf
writeByte (W256 -> Expr 'EWord
Lit W256
x) Expr 'Byte
yByte)
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpSload ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x:[Expr 'EWord]
xs) -> do
              Bool
acc <- Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
self Expr 'EWord
x
              let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_sload
              Word64 -> EVM () -> EVM ()
burn Word64
cost forall a b. (a -> b) -> a -> b
$
                Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
self Expr 'EWord
x forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
y -> do
                  (?op::Word8) => EVM ()
next
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (Expr 'EWord
yforall a. a -> [a] -> [a]
:[Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpSstore ->
          EVM () -> EVM ()
notStatic forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x:Expr 'EWord
new:[Expr 'EWord]
xs) ->
              Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
self Expr 'EWord
x forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
current -> do
                Word64
availableGas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas)

                if forall a b. (Integral a, Num b) => a -> b
num Word64
availableGas forall a. Ord a => a -> a -> Bool
<= Word64
g_callstipend
                  then FrameResult -> EVM ()
finishFrame (Error -> FrameResult
FrameErrored (Word64 -> Word64 -> Error
OutOfGas Word64
availableGas (forall a b. (Integral a, Num b) => a -> b
num Word64
g_callstipend)))
                  else do
                    let original :: W256
original = case Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'EWord
x (Map W256 (Map W256 W256) -> Expr 'Storage
ConcreteStore VM
vm._env._origStorage) of
                                     Just (Lit W256
v) -> W256
v
                                     Maybe (Expr 'EWord)
_ -> W256
0
                    let storage_cost :: Word64
storage_cost = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
current, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
new) of
                                 (Just W256
current', Just W256
new') ->
                                    if (W256
current' forall a. Eq a => a -> a -> Bool
== W256
new') then Word64
g_sload
                                    else if (W256
current' forall a. Eq a => a -> a -> Bool
== W256
original) Bool -> Bool -> Bool
&& (W256
original forall a. Eq a => a -> a -> Bool
== W256
0) then Word64
g_sset
                                    else if (W256
current' forall a. Eq a => a -> a -> Bool
== W256
original) then Word64
g_sreset
                                    else Word64
g_sload

                                 -- if any of the arguments are symbolic,
                                 -- assume worst case scenario
                                 (Maybe W256, Maybe W256)
_ -> Word64
g_sset

                    Bool
acc <- Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
self Expr 'EWord
x
                    let cold_storage_cost :: Word64
cold_storage_cost = if Bool
acc then Word64
0 else Word64
g_cold_sload
                    Word64 -> EVM () -> EVM ()
burn (Word64
storage_cost forall a. Num a => a -> a -> a
+ Word64
cold_storage_cost) forall a b. (a -> b) -> a -> b
$ do
                      (?op::Word8) => EVM ()
next
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage)
                        (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'EWord
x Expr 'EWord
new)

                      case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
current, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
new) of
                         (Just W256
current', Just W256
new') ->
                            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (W256
current' forall a. Eq a => a -> a -> Bool
== W256
new') forall a b. (a -> b) -> a -> b
$
                              if W256
current' forall a. Eq a => a -> a -> Bool
== W256
original
                              then forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
original forall a. Eq a => a -> a -> Bool
/= W256
0 Bool -> Bool -> Bool
&& W256
new' forall a. Eq a => a -> a -> Bool
== W256
0) forall a b. (a -> b) -> a -> b
$
                                      Word64 -> EVM ()
refund (Word64
g_sreset forall a. Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
                              else do
                                      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
original forall a. Eq a => a -> a -> Bool
/= W256
0) forall a b. (a -> b) -> a -> b
$
                                        if W256
new' forall a. Eq a => a -> a -> Bool
== W256
0
                                        then Word64 -> EVM ()
refund (Word64
g_sreset forall a. Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
                                        else Word64 -> EVM ()
unRefund (Word64
g_sreset forall a. Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
                                      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
original forall a. Eq a => a -> a -> Bool
== W256
new') forall a b. (a -> b) -> a -> b
$
                                        if W256
original forall a. Eq a => a -> a -> Bool
== W256
0
                                        then Word64 -> EVM ()
refund (Word64
g_sset forall a. Num a => a -> a -> a
- Word64
g_sload)
                                        else Word64 -> EVM ()
refund (Word64
g_sreset forall a. Num a => a -> a -> a
- Word64
g_sload)
                         -- if any of the arguments are symbolic,
                         -- don't change the refund counter
                         (Maybe W256, Maybe W256)
_ -> forall (m :: * -> *). Monad m => m ()
noop
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpJump ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x:[Expr 'EWord]
xs) ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_mid forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x String
"JUMP: symbolic jumpdest" forall a b. (a -> b) -> a -> b
$ \W256
x' ->
                case W256 -> Maybe Int
toInt W256
x' of
                  Maybe Int
Nothing -> Error -> EVM ()
vmError Error
EVM.BadJumpDestination
                  Just Int
i -> Int -> [Expr 'EWord] -> EVM ()
checkJump Int
i [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpJumpi -> do
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x String
"JUMPI: symbolic jumpdest" forall a b. (a -> b) -> a -> b
$ \W256
x' ->
                Word64 -> EVM () -> EVM ()
burn Word64
g_high forall a b. (a -> b) -> a -> b
$
                  let jump :: Bool -> EVM ()
                      jump :: Bool -> EVM ()
jump Bool
False = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (?op::Word8) => EVM ()
next
                      jump Bool
_    = case W256 -> Maybe Int
toInt W256
x' of
                        Maybe Int
Nothing -> Error -> EVM ()
vmError Error
EVM.BadJumpDestination
                        Just Int
i -> Int -> [Expr 'EWord] -> EVM ()
checkJump Int
i [Expr 'EWord]
xs
                  in case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
y of
                      Just W256
y' -> Bool -> EVM ()
jump (W256
0 forall a. Eq a => a -> a -> Bool
/= W256
y')
                      -- if the jump condition is symbolic, we explore both sides
                      Maybe W256
Nothing -> do
                        CodeLocation
loc <- EVM CodeLocation
codeloc
                        CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc Expr 'EWord
y Bool -> EVM ()
jump
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpPc ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num VM
vm._state._pc)

        GenericOp Word8
OpMsize ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num VM
vm._state._memorySize)

        GenericOp Word8
OpGas ->
          Int -> EVM () -> EVM ()
limitStack Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall a b. (a -> b) -> a -> b
$
            (?op::Word8) => EVM ()
next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num (VM
vm._state._gas forall a. Num a => a -> a -> a
- Word64
g_base))

        GenericOp Word8
OpJumpdest -> Word64 -> EVM () -> EVM ()
burn Word64
g_jumpdest (?op::Word8) => EVM ()
next

        GenericOp Word8
OpExp ->
          -- NOTE: this can be done symbolically using unrolling like this:
          --       https://hackage.haskell.org/package/sbv-9.0/docs/src/Data.SBV.Core.Model.html#.%5E
          --       However, it requires symbolic gas, since the gas depends on the exponent
          case [Expr 'EWord]
stk of
            (Expr 'EWord
base:Expr 'EWord
exponent':[Expr 'EWord]
xs) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
exponent' String
"EXP: symbolic exponent" forall a b. (a -> b) -> a -> b
$ \W256
exponent ->
              let cost :: Word64
cost = if W256
exponent forall a. Eq a => a -> a -> Bool
== W256
0
                         then Word64
g_exp
                         else Word64
g_exp forall a. Num a => a -> a -> a
+ Word64
g_expbyte forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
num (forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Int
1 forall a. Num a => a -> a -> a
+ forall b. FiniteBits b => b -> Int
log2 W256
exponent) Int
8)
              in Word64 -> EVM () -> EVM ()
burn Word64
cost forall a b. (a -> b) -> a -> b
$ do
                (?op::Word8) => EVM ()
next
                Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.exp Expr 'EWord
base Expr 'EWord
exponent' forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpSignextend -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sex)

        GenericOp Word8
OpCreate ->
          EVM () -> EVM ()
notStatic forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xValue' : Expr 'EWord
xOffset' : Expr 'EWord
xSize' : [Expr 'EWord]
xs) -> (Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
xValue', Expr 'EWord
xOffset', Expr 'EWord
xSize') String
"CREATE" forall a b. (a -> b) -> a -> b
$
              \(W256
xValue, W256
xOffset, W256
xSize) -> do
                W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall a b. (a -> b) -> a -> b
$ do
                  Word64
availableGas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas)
                  let
                    newAddr :: Addr
newAddr = Addr -> W256 -> Addr
createAddress Addr
self Contract
this._nonce
                    (Word64
cost, Word64
gas') = FeeSchedule Word64 -> Word64 -> W256 -> (Word64, Word64)
costOfCreate FeeSchedule Word64
fees Word64
availableGas W256
0
                  Bool
_ <- Addr -> EVM Bool
accessAccountForGas Addr
newAddr
                  Word64 -> EVM () -> EVM ()
burn (Word64
cost forall a. Num a => a -> a -> a
- Word64
gas') forall a b. (a -> b) -> a -> b
$ do
                    -- unfortunately we have to apply some (pretty hacky)
                    -- heuristics here to parse the unstructured buffer read
                    -- from memory into a code and data section
                    let initCode :: Expr 'Buf
initCode = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                    (?op::Word8) =>
Addr
-> Contract
-> Word64
-> W256
-> [Expr 'EWord]
-> Addr
-> Expr 'Buf
-> EVM ()
create Addr
self Contract
this (forall a b. (Integral a, Num b) => a -> b
num Word64
gas') W256
xValue [Expr 'EWord]
xs Addr
newAddr Expr 'Buf
initCode
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpCall ->
          case [Expr 'EWord]
stk of
            ( Expr 'EWord
xGas'
              : Expr 'EWord
xTo
              : Expr 'EWord
xValue'
              : Expr 'EWord
xInOffset'
              : Expr 'EWord
xInSize'
              : Expr 'EWord
xOutOffset'
              : Expr 'EWord
xOutSize'
              : [Expr 'EWord]
xs
             ) -> (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
 Expr 'EWord)
-> String
-> ((W256, W256, W256, W256, W256, W256) -> EVM ())
-> EVM ()
forceConcrete6 (Expr 'EWord
xGas', Expr 'EWord
xValue', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') String
"CALL" forall a b. (a -> b) -> a -> b
$
              \(W256
xGas, W256
xValue, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
                (if W256
xValue forall a. Ord a => a -> a -> Bool
> W256
0 then EVM () -> EVM ()
notStatic else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                  (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall a b. (Integral a, Num b) => a -> b
num W256
xGas) Expr 'EWord
xTo Expr 'EWord
xTo W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall a b. (a -> b) -> a -> b
$ \Addr
callee -> do
                    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' VM FrameState
state forall a b. (a -> b) -> a -> b
$ do
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'EWord)
callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'EWord)
caller forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Addr -> Expr 'EWord
litAddr Addr
self) (VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM (Maybe (Expr 'EWord))
overrideCaller)
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Addr
contract Addr
callee
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe (Expr 'EWord))
overrideCaller forall a. Maybe a
Nothing
                    Addr -> Addr -> W256 -> EVM ()
transfer Addr
self Addr
callee W256
xValue
                    Addr -> EVM ()
touchAccount Addr
self
                    Addr -> EVM ()
touchAccount Addr
callee
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpCallcode ->
          case [Expr 'EWord]
stk of
            ( Expr 'EWord
xGas'
              : Expr 'EWord
xTo
              : Expr 'EWord
xValue'
              : Expr 'EWord
xInOffset'
              : Expr 'EWord
xInSize'
              : Expr 'EWord
xOutOffset'
              : Expr 'EWord
xOutSize'
              : [Expr 'EWord]
xs
              ) -> (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
 Expr 'EWord)
-> String
-> ((W256, W256, W256, W256, W256, W256) -> EVM ())
-> EVM ()
forceConcrete6 (Expr 'EWord
xGas', Expr 'EWord
xValue', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') String
"CALLCODE" forall a b. (a -> b) -> a -> b
$
                \(W256
xGas, W256
xValue, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
                  (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall a b. (Integral a, Num b) => a -> b
num W256
xGas) Expr 'EWord
xTo (Addr -> Expr 'EWord
litAddr Addr
self) W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall a b. (a -> b) -> a -> b
$ \Addr
_ -> do
                    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' VM FrameState
state forall a b. (a -> b) -> a -> b
$ do
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'EWord)
callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'EWord)
caller forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Addr -> Expr 'EWord
litAddr Addr
self) (VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM (Maybe (Expr 'EWord))
overrideCaller)
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe (Expr 'EWord))
overrideCaller forall a. Maybe a
Nothing
                    Addr -> EVM ()
touchAccount Addr
self
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpReturn ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xOffset' : Expr 'EWord
xSize' :[Expr 'EWord]
_) -> (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xOffset', Expr 'EWord
xSize') String
"RETURN" forall a b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) ->
              W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall a b. (a -> b) -> a -> b
$ do
                let
                  output :: Expr 'Buf
output = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                  codesize :: W256
codesize = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"RETURN: cannot return dynamically sized abstract data")
                               forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> Maybe W256
unlit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> Expr 'EWord
bufLength forall a b. (a -> b) -> a -> b
$ Expr 'Buf
output
                  maxsize :: W256
maxsize = VM
vm._block._maxCodeSize
                  creation :: Bool
creation = case VM
vm._frames of
                    [] -> VM
vm._tx._isCreate
                    Frame
frame:[Frame]
_ -> case Frame
frame._frameContext of
                       CreationContext {} -> Bool
True
                       CallContext {} -> Bool
False
                if Bool
creation
                then
                  if W256
codesize forall a. Ord a => a -> a -> Bool
> W256
maxsize
                  then
                    FrameResult -> EVM ()
finishFrame (Error -> FrameResult
FrameErrored (W256 -> W256 -> Error
MaxCodeSizeExceeded W256
maxsize W256
codesize))
                  else do
                    let frameReturned :: EVM ()
frameReturned = Word64 -> EVM () -> EVM ()
burn (Word64
g_codedeposit forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
num W256
codesize) forall a b. (a -> b) -> a -> b
$
                                          FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
                        frameErrored :: EVM ()
frameErrored = FrameResult -> EVM ()
finishFrame forall a b. (a -> b) -> a -> b
$ Error -> FrameResult
FrameErrored Error
InvalidFormat
                    case Expr 'EWord -> Expr 'Buf -> Expr 'Byte
readByte (W256 -> Expr 'EWord
Lit W256
0) Expr 'Buf
output of
                      LitByte Word8
0xef -> EVM ()
frameErrored
                      LitByte Word8
_ -> EVM ()
frameReturned
                      Expr 'Byte
y -> do
                        CodeLocation
loc <- EVM CodeLocation
codeloc
                        CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc (Expr 'Byte -> Expr 'Byte -> Expr 'EWord
Expr.eqByte Expr 'Byte
y (Word8 -> Expr 'Byte
LitByte Word8
0xef)) forall a b. (a -> b) -> a -> b
$ \case
                          Bool
True -> EVM ()
frameErrored
                          Bool
False -> EVM ()
frameReturned
                else
                   FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpDelegatecall ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xGas'
             :Expr 'EWord
xTo
             :Expr 'EWord
xInOffset'
             :Expr 'EWord
xInSize'
             :Expr 'EWord
xOutOffset'
             :Expr 'EWord
xOutSize'
             :[Expr 'EWord]
xs) -> (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 (Expr 'EWord
xGas', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') String
"DELEGATECALL" forall a b. (a -> b) -> a -> b
$
              \(W256
xGas, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
                (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall a b. (Integral a, Num b) => a -> b
num W256
xGas) Expr 'EWord
xTo (Addr -> Expr 'EWord
litAddr Addr
self) W256
0 W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall a b. (a -> b) -> a -> b
$ \Addr
_ -> do
                  Addr -> EVM ()
touchAccount Addr
self
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpCreate2 -> EVM () -> EVM ()
notStatic forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xValue'
             :Expr 'EWord
xOffset'
             :Expr 'EWord
xSize'
             :Expr 'EWord
xSalt'
             :[Expr 'EWord]
xs) -> (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete4 (Expr 'EWord
xValue', Expr 'EWord
xOffset', Expr 'EWord
xSize', Expr 'EWord
xSalt') String
"CREATE2" forall a b. (a -> b) -> a -> b
$
              \(W256
xValue, W256
xOffset, W256
xSize, W256
xSalt) ->
                W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall a b. (a -> b) -> a -> b
$ do
                  Word64
availableGas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas)

                  Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf (Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm) String
"CREATE2" forall a b. (a -> b) -> a -> b
$
                    \ByteString
initCode -> do
                      let
                        newAddr :: Addr
newAddr  = Addr -> W256 -> ByteString -> Addr
create2Address Addr
self W256
xSalt ByteString
initCode
                        (Word64
cost, Word64
gas') = FeeSchedule Word64 -> Word64 -> W256 -> (Word64, Word64)
costOfCreate FeeSchedule Word64
fees Word64
availableGas W256
xSize
                      Bool
_ <- Addr -> EVM Bool
accessAccountForGas Addr
newAddr
                      Word64 -> EVM () -> EVM ()
burn (Word64
cost forall a. Num a => a -> a -> a
- Word64
gas') forall a b. (a -> b) -> a -> b
$ (?op::Word8) =>
Addr
-> Contract
-> Word64
-> W256
-> [Expr 'EWord]
-> Addr
-> Expr 'Buf
-> EVM ()
create Addr
self Contract
this Word64
gas' W256
xValue [Expr 'EWord]
xs Addr
newAddr (ByteString -> Expr 'Buf
ConcreteBuf ByteString
initCode)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpStaticcall ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xGas'
             :Expr 'EWord
xTo
             :Expr 'EWord
xInOffset'
             :Expr 'EWord
xInSize'
             :Expr 'EWord
xOutOffset'
             :Expr 'EWord
xOutSize'
             :[Expr 'EWord]
xs) -> (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 (Expr 'EWord
xGas', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') String
"STATICCALL" forall a b. (a -> b) -> a -> b
$
              \(W256
xGas, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) -> do
                (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall a b. (Integral a, Num b) => a -> b
num W256
xGas) Expr 'EWord
xTo Expr 'EWord
xTo W256
0 W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall a b. (a -> b) -> a -> b
$ \Addr
callee -> do
                  forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' VM FrameState
state forall a b. (a -> b) -> a -> b
$ do
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'EWord)
callvalue (W256 -> Expr 'EWord
Lit W256
0)
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'EWord)
caller forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Addr -> Expr 'EWord
litAddr Addr
self) (VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM (Maybe (Expr 'EWord))
overrideCaller)
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Addr
contract Addr
callee
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Bool
static Bool
True
                  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe (Expr 'EWord))
overrideCaller forall a. Maybe a
Nothing
                  Addr -> EVM ()
touchAccount Addr
self
                  Addr -> EVM ()
touchAccount Addr
callee
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpSelfdestruct ->
          EVM () -> EVM ()
notStatic forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            [] -> EVM ()
underrun
            (Expr 'EWord
xTo':[Expr 'EWord]
_) -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
xTo' String
"SELFDESTRUCT" forall a b. (a -> b) -> a -> b
$ \(forall a b. (Integral a, Num b) => a -> b
num -> Addr
xTo) -> do
              Bool
acc <- Addr -> EVM Bool
accessAccountForGas (forall a b. (Integral a, Num b) => a -> b
num Addr
xTo)
              let cost :: Word64
cost = if Bool
acc then Word64
0 else Word64
g_cold_account_access
                  funds :: W256
funds = Contract
this._balance
                  recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xTo VM
vm
                  c_new :: Word64
c_new = if Bool -> Bool
not Bool
recipientExists Bool -> Bool -> Bool
&& W256
funds forall a. Eq a => a -> a -> Bool
/= W256
0
                          then Word64
g_selfdestruct_newaccount
                          else Word64
0
              Word64 -> EVM () -> EVM ()
burn (Word64
g_selfdestruct forall a. Num a => a -> a -> a
+ Word64
c_new forall a. Num a => a -> a -> a
+ Word64
cost) forall a b. (a -> b) -> a -> b
$ do
                   Addr -> EVM ()
selfdestruct Addr
self
                   Addr -> EVM ()
touchAccount Addr
xTo

                   if W256
funds forall a. Eq a => a -> a -> Bool
/= W256
0
                   then Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
xTo forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                          Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
xTo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract W256
balance forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= W256
funds
                          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
self forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract W256
balance) W256
0
                          EVM ()
doStop
                   else EVM ()
doStop

        GenericOp Word8
OpRevert ->
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
_) -> (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xOffset', Expr 'EWord
xSize') String
"REVERT" forall a b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) ->
              W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall a b. (a -> b) -> a -> b
$ do
                let output :: Expr 'Buf
output = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReverted Expr 'Buf
output)
            [Expr 'EWord]
_ -> EVM ()
underrun

        OpUnknown Word8
xxx ->
          Error -> EVM ()
vmError (Word8 -> Error
UnrecognizedOpcode Word8
xxx)

transfer :: Addr -> Addr -> W256 -> EVM ()
transfer :: Addr -> Addr -> W256 -> EVM ()
transfer Addr
xFrom Addr
xTo W256
xValue =
  forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts) forall a b. (a -> b) -> a -> b
$ do
    forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
xFrom forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract W256
balance forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= W256
xValue
    forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
xTo  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract W256
balance forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= W256
xValue

-- | Checks a *CALL for failure; OOG, too many callframes, memory access etc.
callChecks
  :: (?op :: Word8)
  => Contract -> Word64 -> Addr -> Addr -> W256 -> W256 -> W256 -> W256 -> W256 -> [Expr EWord]
   -- continuation with gas available for call
  -> (Word64 -> EVM ())
  -> EVM ()
callChecks :: (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
xGas Addr
xContext Addr
xTo W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs Word64 -> EVM ()
continue = do
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
  let fees :: FeeSchedule Word64
fees = VM
vm._block._schedule
  W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xInOffset W256
xInSize forall a b. (a -> b) -> a -> b
$
    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOutOffset W256
xOutSize forall a b. (a -> b) -> a -> b
$ do
      Word64
availableGas <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas)
      let recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xContext VM
vm
      (Word64
cost, Word64
gas') <- FeeSchedule Word64
-> Bool -> W256 -> Word64 -> Word64 -> Addr -> EVM (Word64, Word64)
costOfCall FeeSchedule Word64
fees Bool
recipientExists W256
xValue Word64
availableGas Word64
xGas Addr
xTo
      Word64 -> EVM () -> EVM ()
burn (Word64
cost forall a. Num a => a -> a -> a
- Word64
gas') forall a b. (a -> b) -> a -> b
$ do
        if W256
xValue forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
num Contract
this._balance
        then do
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
          TraceData -> EVM ()
pushTrace forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> Error
BalanceTooLow W256
xValue Contract
this._balance
          (?op::Word8) => EVM ()
next
        else if forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm._frames forall a. Ord a => a -> a -> Bool
>= Int
1024
             then do
               forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
               forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
               TraceData -> EVM ()
pushTrace forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
CallDepthLimitReached
               (?op::Word8) => EVM ()
next
             else Word64 -> EVM ()
continue Word64
gas'

precompiledContract
  :: (?op :: Word8)
  => Contract
  -> Word64
  -> Addr
  -> Addr
  -> W256
  -> W256 -> W256 -> W256 -> W256
  -> [Expr EWord]
  -> EVM ()
precompiledContract :: (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
precompiledContract Contract
this Word64
xGas Addr
precompileAddr Addr
recipient W256
xValue W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs =
  (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
xGas Addr
recipient Addr
precompileAddr W256
xValue W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs forall a b. (a -> b) -> a -> b
$ \Word64
gas' ->
  do
    (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
precompileAddr Word64
gas' W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs
    Addr
self <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract)
    [Expr 'EWord]
stk <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack)
    Int
pc' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Int
pc)
    Maybe VMResult
result' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' VM (Maybe VMResult)
result
    case Maybe VMResult
result' of
      Maybe VMResult
Nothing -> case [Expr 'EWord]
stk of
        (Expr 'EWord
x:[Expr 'EWord]
_) -> case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
x of
          Just W256
0 ->
            forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just W256
1 ->
            Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
recipient forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
              Addr -> Addr -> W256 -> EVM ()
transfer Addr
self Addr
recipient W256
xValue
              Addr -> EVM ()
touchAccount Addr
self
              Addr -> EVM ()
touchAccount Addr
recipient
          Maybe W256
_ -> Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg Int
pc' String
"unexpected return value from precompile" [Expr 'EWord
x]
        [Expr 'EWord]
_ -> EVM ()
underrun
      Maybe VMResult
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

executePrecompile
  :: (?op :: Word8)
  => Addr
  -> Word64 -> W256 -> W256 -> W256 -> W256 -> [Expr EWord]
  -> EVM ()
executePrecompile :: (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
preCompileAddr Word64
gasCap W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs  = do
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
  let input :: Expr 'Buf
input = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit W256
inOffset) (W256 -> Expr 'EWord
Lit W256
inSize) VM
vm
      fees :: FeeSchedule Word64
fees = VM
vm._block._schedule
      cost :: Word64
cost = FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile FeeSchedule Word64
fees Addr
preCompileAddr Expr 'Buf
input
      notImplemented :: EVM ()
notImplemented = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"precompile at address " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Addr
preCompileAddr forall a. Semigroup a => a -> a -> a
<> String
" not yet implemented"
      precompileFail :: EVM ()
precompileFail = Word64 -> EVM () -> EVM ()
burn (Word64
gasCap forall a. Num a => a -> a -> a
- Word64
cost) forall a b. (a -> b) -> a -> b
$ do
                         forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                         TraceData -> EVM ()
pushTrace forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
PrecompileFailure
                         (?op::Word8) => EVM ()
next
  if Word64
cost forall a. Ord a => a -> a -> Bool
> Word64
gasCap then
    Word64 -> EVM () -> EVM ()
burn Word64
gasCap forall a b. (a -> b) -> a -> b
$ do
      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
      (?op::Word8) => EVM ()
next
  else
    Word64 -> EVM () -> EVM ()
burn Word64
cost forall a b. (a -> b) -> a -> b
$
      case Addr
preCompileAddr of
        -- ECRECOVER
        Addr
0x1 ->
          -- TODO: support symbolic variant
          Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"ECRECOVER" forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
            case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x1 (Int -> ByteString -> ByteString
truncpadlit Int
128 ByteString
input') Int
32 of
              Maybe ByteString
Nothing -> do
                -- return no output for invalid signature
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
                (?op::Word8) => EVM ()
next
              Just ByteString
output -> do
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output)
                Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output) (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
                (?op::Word8) => EVM ()
next

        -- SHA2-256
        Addr
0x2 -> Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"SHA2-256" forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          let
            hash :: Expr 'Buf
hash = forall {ba}. ByteArrayAccess ba => ba -> Expr 'Buf
sha256Buf ByteString
input'
            sha256Buf :: ba -> Expr 'Buf
sha256Buf ba
x = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ba
x :: Digest SHA256)
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
hash
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
hash (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
          (?op::Word8) => EVM ()
next

        -- RIPEMD-160
        Addr
0x3 ->
         -- TODO: support symbolic variant
         Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"RIPEMD160" forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->

          let
            padding :: ByteString
padding = [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
12 Word8
0
            hash' :: ByteString
hash' = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
input' :: Digest RIPEMD160)
            hash :: Expr 'Buf
hash  = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$ ByteString
padding forall a. Semigroup a => a -> a -> a
<> ByteString
hash'
          in do
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
hash
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
hash (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            (?op::Word8) => EVM ()
next

        -- IDENTITY
        Addr
0x4 -> do
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
input
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
input (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            (?op::Word8) => EVM ()
next

        -- MODEXP
        Addr
0x5 ->
         -- TODO: support symbolic variant
         Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"MODEXP" forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->

          let
            (W256
lenb, W256
lene, W256
lenm) = ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input'

            output :: Expr 'Buf
output = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$
              if W256 -> W256 -> ByteString -> Bool
isZero (W256
96 forall a. Num a => a -> a -> a
+ W256
lenb forall a. Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
              then Int -> ByteString -> ByteString
truncpadlit (forall a b. (Integral a, Num b) => a -> b
num W256
lenm) (forall a. Integral a => a -> ByteString
asBE (Int
0 :: Int))
              else
                let
                  b :: Integer
b = ByteString -> Integer
asInteger forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
96 W256
lenb ByteString
input'
                  e :: Integer
e = ByteString -> Integer
asInteger forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 forall a. Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input'
                  m :: Integer
m = ByteString -> Integer
asInteger forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 forall a. Num a => a -> a -> a
+ W256
lenb forall a. Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
                in
                  Int -> ByteString -> ByteString
padLeft (forall a b. (Integral a, Num b) => a -> b
num W256
lenm) (forall a. Integral a => a -> ByteString
asBE (Integer -> Integer -> Integer -> Integer
expFast Integer
b Integer
e Integer
m))
          in do
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
output
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
output (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            (?op::Word8) => EVM ()
next

        -- ECADD
        Addr
0x6 ->
         -- TODO: support symbolic variant
         Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"ECADD" forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->
           case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x6 (Int -> ByteString -> ByteString
truncpadlit Int
128 ByteString
input') Int
64 of
          Maybe ByteString
Nothing -> EVM ()
precompileFail
          Just ByteString
output -> do
            let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            (?op::Word8) => EVM ()
next

        -- ECMUL
        Addr
0x7 ->
         -- TODO: support symbolic variant
         Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"ECMUL" forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->

          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x7 (Int -> ByteString -> ByteString
truncpadlit Int
96 ByteString
input') Int
64 of
          Maybe ByteString
Nothing -> EVM ()
precompileFail
          Just ByteString
output -> do
            let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            (?op::Word8) => EVM ()
next

        -- ECPAIRING
        Addr
0x8 ->
         -- TODO: support symbolic variant
         Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"ECPAIR" forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->

          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x8 ByteString
input' Int
32 of
          Maybe ByteString
Nothing -> EVM ()
precompileFail
          Just ByteString
output -> do
            let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
32 ByteString
output
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            (?op::Word8) => EVM ()
next

        -- BLAKE2
        Addr
0x9 ->
         -- TODO: support symbolic variant
         Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input String
"BLAKE2" forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do

          case (ByteString -> Int
BS.length ByteString
input', Word8
1 forall a. Ord a => a -> a -> Bool
>= HasCallStack => ByteString -> Word8
BS.last ByteString
input') of
            (Int
213, Bool
True) -> case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x9 ByteString
input' Int
64 of
              Just ByteString
output -> do
                let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
1 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
truncpaddedOutput
                Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
                (?op::Word8) => EVM ()
next
              Maybe ByteString
Nothing -> EVM ()
precompileFail
            (Int, Bool)
_ -> EVM ()
precompileFail


        Addr
_   -> EVM ()
notImplemented

truncpadlit :: Int -> ByteString -> ByteString
truncpadlit :: Int -> ByteString -> ByteString
truncpadlit Int
n ByteString
xs = if Int
m forall a. Ord a => a -> a -> Bool
> Int
n then Int -> ByteString -> ByteString
BS.take Int
n ByteString
xs
                   else ByteString -> ByteString -> ByteString
BS.append ByteString
xs (Int -> Word8 -> ByteString
BS.replicate (Int
n forall a. Num a => a -> a -> a
- Int
m) Word8
0)
  where m :: Int
m = ByteString -> Int
BS.length ByteString
xs

lazySlice :: W256 -> W256 -> ByteString -> LS.ByteString
lazySlice :: W256 -> W256 -> ByteString -> ByteString
lazySlice W256
offset W256
size ByteString
bs =
  let bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LS.take (forall a b. (Integral a, Num b) => a -> b
num W256
size) (Int64 -> ByteString -> ByteString
LS.drop (forall a b. (Integral a, Num b) => a -> b
num W256
offset) (ByteString -> ByteString
fromStrict ByteString
bs))
  in ByteString
bs' forall a. Semigroup a => a -> a -> a
<> Int64 -> Word8 -> ByteString
LS.replicate ((forall a b. (Integral a, Num b) => a -> b
num W256
size) forall a. Num a => a -> a -> a
- ByteString -> Int64
LS.length ByteString
bs') Word8
0

parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input =
  let lenb :: W256
lenb = ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice  W256
0 W256
32 ByteString
input
      lene :: W256
lene = ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
32 W256
64 ByteString
input
      lenm :: W256
lenm = ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
64 W256
96 ByteString
input
  in (W256
lenb, W256
lene, W256
lenm)

--- checks if a range of ByteString bs starting at offset and length size is all zeros.
isZero :: W256 -> W256 -> ByteString -> Bool
isZero :: W256 -> W256 -> ByteString -> Bool
isZero W256
offset W256
size ByteString
bs =
  (Word8 -> Bool) -> ByteString -> Bool
LS.all (forall a. Eq a => a -> a -> Bool
== Word8
0) forall a b. (a -> b) -> a -> b
$
    Int64 -> ByteString -> ByteString
LS.take (forall a b. (Integral a, Num b) => a -> b
num W256
size) forall a b. (a -> b) -> a -> b
$
      Int64 -> ByteString -> ByteString
LS.drop (forall a b. (Integral a, Num b) => a -> b
num W256
offset) forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString
fromStrict ByteString
bs

asInteger :: LS.ByteString -> Integer
asInteger :: ByteString -> Integer
asInteger ByteString
xs = if ByteString
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then Integer
0
  else Integer
256 forall a. Num a => a -> a -> a
* ByteString -> Integer
asInteger (HasCallStack => ByteString -> ByteString
LS.init ByteString
xs)
      forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
num (HasCallStack => ByteString -> Word8
LS.last ByteString
xs)

-- * Opcode helper actions

noop :: Monad m => m ()
noop :: forall (m :: * -> *). Monad m => m ()
noop = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

pushTo :: MonadState s m => ASetter s s [a] [a] -> a -> m ()
pushTo :: forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo ASetter s s [a] [a]
f a
x = ASetter s s [a] [a]
f forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (a
x :)

pushToSequence :: MonadState s m => ASetter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence :: forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence ASetter s s (Seq a) (Seq a)
f a
x = ASetter s s (Seq a) (Seq a)
f forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Seq a -> a -> Seq a
Seq.|> a
x)

getCodeLocation :: VM -> CodeLocation
getCodeLocation :: VM -> CodeLocation
getCodeLocation VM
vm = (VM
vm._state._contract, VM
vm._state._pc)

branch :: CodeLocation -> Expr EWord -> (Bool -> EVM ()) -> EVM ()
branch :: CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc Expr 'EWord
cond Bool -> EVM ()
continue = do
  [Prop]
pathconds <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' VM [Prop]
constraints
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> [Prop] -> (BranchCondition -> EVM ()) -> Query
PleaseAskSMT Expr 'EWord
cond [Prop]
pathconds BranchCondition -> EVM ()
choosePath
  where
     choosePath :: BranchCondition -> EVM ()
choosePath (Case Bool
v) = do forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall a. Maybe a
Nothing
                              forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo Lens' VM [Prop]
constraints forall a b. (a -> b) -> a -> b
$ if Bool
v then (Expr 'EWord
cond forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
./= (W256 -> Expr 'EWord
Lit W256
0)) else (Expr 'EWord
cond forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== (W256 -> Expr 'EWord
Lit W256
0))
                              Int
iteration <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM (Map CodeLocation Int)
iterations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non Int
0)
                              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Cache
cache forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Cache (Map (CodeLocation, Int) Bool)
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (CodeLocation
loc, Int
iteration)) (forall a. a -> Maybe a
Just Bool
v)
                              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM (Map CodeLocation Int)
iterations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
loc) (forall a. a -> Maybe a
Just (Int
iteration forall a. Num a => a -> a -> a
+ Int
1))
                              Bool -> EVM ()
continue Bool
v
     -- Both paths are possible; we ask for more input
     choosePath BranchCondition
Unknown = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choose -> Error
Choose forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> (Bool -> EVM ()) -> Choose
PleaseChoosePath Expr 'EWord
cond forall a b. (a -> b) -> a -> b
$ BranchCondition -> EVM ()
choosePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BranchCondition
Case
     -- None of the paths are possible; fail this branch
     choosePath BranchCondition
Inconsistent = Error -> EVM ()
vmError Error
DeadPath


-- | Construct RPC Query and halt execution until resolved
fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr Contract -> EVM ()
continue =
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Contract
c -> Contract -> EVM ()
continue Contract
c
    Maybe Contract
Nothing ->
      forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Cache
cache forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Cache (Map Addr Contract)
fetchedContracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Contract
c -> do
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall a. a -> Maybe a
Just Contract
c)
          Contract -> EVM ()
continue Contract
c
        Maybe Contract
Nothing -> do
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure forall a b. (a -> b) -> a -> b
$ Query -> Error
Query forall a b. (a -> b) -> a -> b
$
            Addr -> (Contract -> EVM ()) -> Query
PleaseFetchContract Addr
addr
              (\Contract
c -> do forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Cache
cache forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Cache (Map Addr Contract)
fetchedContracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall a. a -> Maybe a
Just Contract
c)
                        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall a. a -> Maybe a
Just Contract
c)
                        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall a. Maybe a
Nothing
                        Contract -> EVM ()
continue Contract
c)

accessStorage
  :: Addr                   -- ^ Contract address
  -> Expr EWord             -- ^ Storage slot key
  -> (Expr EWord -> EVM ()) -- ^ Continuation
  -> EVM ()
accessStorage :: Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
addr Expr 'EWord
slot Expr 'EWord -> EVM ()
continue = do
  Expr 'Storage
store <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage)
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Contract
c ->
      case Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot Expr 'Storage
store of
        -- Notice that if storage is symbolic, we always continue straight away
        Just Expr 'EWord
x ->
          Expr 'EWord -> EVM ()
continue Expr 'EWord
x
        Maybe (Expr 'EWord)
Nothing ->
          if Contract
c._external then
            Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
slot String
"cannot read symbolic slots via RPC" forall a b. (a -> b) -> a -> b
$ \W256
litSlot -> do
              -- check if the slot is cached
              Map W256 (Map W256 W256)
cachedStore <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Cache
cache forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Cache (Map W256 (Map W256 W256))
fetchedStorage)
              case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
num Addr
addr) Map W256 (Map W256 W256)
cachedStore forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup W256
litSlot of
                Maybe W256
Nothing -> W256 -> EVM ()
mkQuery W256
litSlot
                Just W256
val -> Expr 'EWord -> EVM ()
continue (W256 -> Expr 'EWord
Lit W256
val)
          else do
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
0))
            Expr 'EWord -> EVM ()
continue forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord
Lit W256
0
    Maybe Contract
Nothing ->
      Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr forall a b. (a -> b) -> a -> b
$ \Contract
_ ->
        Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
addr Expr 'EWord
slot Expr 'EWord -> EVM ()
continue
  where
      mkQuery :: W256 -> EVM ()
mkQuery W256
s = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query forall a b. (a -> b) -> a -> b
$
                    Addr -> W256 -> (W256 -> EVM ()) -> Query
PleaseFetchSlot Addr
addr W256
s
                      (\W256
x -> do
                          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Cache
cache forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Cache (Map W256 (Map W256 W256))
fetchedStorage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a b. (Integral a, Num b) => a -> b
num Addr
addr)) (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert W256
s W256
x)
                          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
x))
                          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall a. Maybe a
Nothing
                          Expr 'EWord -> EVM ()
continue (W256 -> Expr 'EWord
Lit W256
x))

accountExists :: Addr -> VM -> Bool
accountExists :: Addr -> VM -> Bool
accountExists Addr
addr VM
vm =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
addr VM
vm._env._contracts of
    Just Contract
c -> Bool -> Bool
not (Contract -> Bool
accountEmpty Contract
c)
    Maybe Contract
Nothing -> Bool
False

-- EIP 161
accountEmpty :: Contract -> Bool
accountEmpty :: Contract -> Bool
accountEmpty Contract
c =
  case Contract
c._contractcode of
    RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
True
    RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
b) -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector (Expr 'Byte)
b
    ContractCode
_ -> Bool
False
  Bool -> Bool -> Bool
&& Contract
c._nonce forall a. Eq a => a -> a -> Bool
== W256
0
  Bool -> Bool -> Bool
&& Contract
c._balance  forall a. Eq a => a -> a -> Bool
== W256
0

-- * How to finalize a transaction
finalize :: EVM ()
finalize :: EVM ()
finalize = do
  let
    revertContracts :: EVM ()
revertContracts  = forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState (Map Addr Contract)
txReversion) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
    revertSubstate :: EVM ()
revertSubstate   = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate) ([Addr]
-> [Addr]
-> Set Addr
-> Set (Addr, W256)
-> [(Addr, Word64)]
-> SubState
SubState forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)

  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' VM (Maybe VMResult)
result forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe VMResult
Nothing ->
      forall a. HasCallStack => String -> a
error String
"Finalising an unfinished tx."
    Just (VMFailure (EVM.Revert Expr 'Buf
_)) -> do
      EVM ()
revertContracts
      EVM ()
revertSubstate
    Just (VMFailure Error
_) -> do
      -- burn remaining gas
      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas) Word64
0
      EVM ()
revertContracts
      EVM ()
revertSubstate
    Just (VMSuccess Expr 'Buf
output) -> do
      -- deposit the code from a creation tx
      Int
pc' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Int
pc)
      Bool
creation <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState Bool
isCreate)
      Addr
createe  <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract)
      Bool
createeExists <- (forall k a. Ord k => k -> Map k a -> Bool
Map.member Addr
createe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
      let onContractCode :: ContractCode -> EVM ()
onContractCode ContractCode
contractCode =
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
creation Bool -> Bool -> Bool
&& Bool
createeExists) forall a b. (a -> b) -> a -> b
$ Addr -> ContractCode -> EVM ()
replaceCode Addr
createe ContractCode
contractCode
      case Expr 'Buf
output of
        ConcreteBuf ByteString
bs ->
          ContractCode -> EVM ()
onContractCode forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
bs)
        Expr 'Buf
_ ->
          case Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList Expr 'Buf
output of
            Maybe (Vector (Expr 'Byte))
Nothing ->
              Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg Int
pc' String
"runtime code cannot have an abstract lentgh" [Expr 'Buf
output]
            Just Vector (Expr 'Byte)
ops ->
              ContractCode -> EVM ()
onContractCode forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
ops)

  -- compute and pay the refund to the caller and the
  -- corresponding payment to the miner
  Addr
txOrigin     <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState Addr
origin)
  Word64
sumRefunds   <- (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a, b) -> b
snd <$>)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [(Addr, Word64)]
refunds))
  Addr
miner        <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Block
block forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Block Addr
coinbase)
  W256
blockReward  <- forall a b. (Integral a, Num b) => a -> b
num forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.r_block) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Block
block forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Block (FeeSchedule Word64)
schedule))
  W256
gasPrice     <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState W256
gasprice)
  W256
priorityFee  <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState W256
txPriorityFee)
  Word64
gasLimit     <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState Word64
txgaslimit)
  Word64
gasRemaining <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas)

  let
    gasUsed :: Word64
gasUsed      = Word64
gasLimit forall a. Num a => a -> a -> a
- Word64
gasRemaining
    cappedRefund :: Word64
cappedRefund = forall a. Ord a => a -> a -> a
min (forall a. Integral a => a -> a -> a
quot Word64
gasUsed Word64
5) (forall a b. (Integral a, Num b) => a -> b
num Word64
sumRefunds)
    originPay :: W256
originPay    = (forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ Word64
gasRemaining forall a. Num a => a -> a -> a
+ Word64
cappedRefund) forall a. Num a => a -> a -> a
* W256
gasPrice

    minerPay :: W256
minerPay     = W256
priorityFee forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
num Word64
gasUsed)

  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
     (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Contract W256
balance (forall a. Num a => a -> a -> a
+ W256
originPay)) Addr
txOrigin)
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
     (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Contract W256
balance (forall a. Num a => a -> a -> a
+ W256
minerPay)) Addr
miner)
  Addr -> EVM ()
touchAccount Addr
miner

  -- pay out the block reward, recreating the miner if necessary
  forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
miner) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Contract
Nothing -> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
      (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Addr
miner (ContractCode -> Contract
initialContract (RuntimeCode -> ContractCode
EVM.RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
""))))
    Just Contract
_  -> forall (m :: * -> *). Monad m => m ()
noop
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
    (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Contract W256
balance (forall a. Num a => a -> a -> a
+ W256
blockReward)) Addr
miner)

  -- perform state trie clearing (EIP 161), of selfdestructs
  -- and touched accounts. addresses are cleared if they have
  --    a) selfdestructed, or
  --    b) been touched and
  --    c) are empty.
  -- (see Yellow Paper "Accrued Substate")
  --
  -- remove any destructed addresses
  [Addr]
destroyedAddresses <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [Addr]
selfdestructs)
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
    (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Addr
k Contract
_ -> (Addr
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Addr]
destroyedAddresses)))
  -- then, clear any remaining empty and touched addresses
  [Addr]
touchedAddresses <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [Addr]
touchedAccounts)
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts)
    (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
      (\Addr
k Contract
a -> Bool -> Bool
not ((Addr
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Addr]
touchedAddresses) Bool -> Bool -> Bool
&& Contract -> Bool
accountEmpty Contract
a)))

-- | Loads the selected contract as the current contract to execute
loadContract :: Addr -> EVM ()
loadContract :: Addr -> EVM ()
loadContract Addr
target =
  forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
target forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract ContractCode
contractcode) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe ContractCode
Nothing ->
        forall a. HasCallStack => String -> a
error String
"Call target doesn't exist"
      Just ContractCode
targetCode -> do
        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract) Addr
target
        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState ContractCode
code)     ContractCode
targetCode
        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
codeContract) Addr
target

limitStack :: Int -> EVM () -> EVM ()
limitStack :: Int -> EVM () -> EVM ()
limitStack Int
n EVM ()
continue = do
  [Expr 'EWord]
stk <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack)
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
stk forall a. Num a => a -> a -> a
+ Int
n forall a. Ord a => a -> a -> Bool
> Int
1024
    then Error -> EVM ()
vmError Error
EVM.StackLimitExceeded
    else EVM ()
continue

notStatic :: EVM () -> EVM ()
notStatic :: EVM () -> EVM ()
notStatic EVM ()
continue = do
  Bool
bad <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Bool
static)
  if Bool
bad
    then Error -> EVM ()
vmError Error
StateChangeWhileStatic
    else EVM ()
continue

-- | Burn gas, failing if insufficient gas is available
burn :: Word64 -> EVM () -> EVM ()
burn :: Word64 -> EVM () -> EVM ()
burn Word64
n EVM ()
continue = do
  Word64
available <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas)
  if Word64
n forall a. Ord a => a -> a -> Bool
<= Word64
available
    then do
      Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= Word64
n
      Lens' VM Word64
burned forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Word64
n
      EVM ()
continue
    else
      Error -> EVM ()
vmError (Word64 -> Word64 -> Error
OutOfGas Word64
available Word64
n)

forceConcrete :: Expr EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete :: Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
n String
msg W256 -> EVM ()
continue = case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n of
  Maybe W256
Nothing -> do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'EWord
n]
  Just W256
c -> W256 -> EVM ()
continue W256
c

forceConcrete2 :: (Expr EWord, Expr EWord) -> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 :: (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
n,Expr 'EWord
m) String
msg (W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
c, Just W256
d) -> (W256, W256) -> EVM ()
continue (W256
c, W256
d)
  (Maybe W256, Maybe W256)
_ -> do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'EWord
n, Expr 'EWord
m]

forceConcrete3 :: (Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
k,Expr 'EWord
n,Expr 'EWord
m) String
msg (W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
c, Just W256
d, Just W256
f) -> (W256, W256, W256) -> EVM ()
continue (W256
c, W256
d, W256
f)
  (Maybe W256, Maybe W256, Maybe W256)
_ -> do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'EWord
k, Expr 'EWord
n, Expr 'EWord
m]

forceConcrete4 :: (Expr EWord, Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete4 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete4 (Expr 'EWord
k,Expr 'EWord
l,Expr 'EWord
n,Expr 'EWord
m) String
msg (W256, W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
l, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
b, Just W256
c, Just W256
d, Just W256
f) -> (W256, W256, W256, W256) -> EVM ()
continue (W256
b, W256
c, W256
d, W256
f)
  (Maybe W256, Maybe W256, Maybe W256, Maybe W256)
_ -> do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'EWord
k, Expr 'EWord
l, Expr 'EWord
n, Expr 'EWord
m]

forceConcrete5 :: (Expr EWord, Expr EWord, Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 (Expr 'EWord
k,Expr 'EWord
l,Expr 'EWord
m,Expr 'EWord
n,Expr 'EWord
o) String
msg (W256, W256, W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
l, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
o) of
  (Just W256
a, Just W256
b, Just W256
c, Just W256
d, Just W256
e) -> (W256, W256, W256, W256, W256) -> EVM ()
continue (W256
a, W256
b, W256
c, W256
d, W256
e)
  (Maybe W256, Maybe W256, Maybe W256, Maybe W256, Maybe W256)
_ -> do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'EWord
k, Expr 'EWord
l, Expr 'EWord
m, Expr 'EWord
n, Expr 'EWord
o]

forceConcrete6 :: (Expr EWord, Expr EWord, Expr EWord, Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete6 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
 Expr 'EWord)
-> String
-> ((W256, W256, W256, W256, W256, W256) -> EVM ())
-> EVM ()
forceConcrete6 (Expr 'EWord
k,Expr 'EWord
l,Expr 'EWord
m,Expr 'EWord
n,Expr 'EWord
o,Expr 'EWord
p) String
msg (W256, W256, W256, W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
l, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
o, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
p) of
  (Just W256
a, Just W256
b, Just W256
c, Just W256
d, Just W256
e, Just W256
f) -> (W256, W256, W256, W256, W256, W256) -> EVM ()
continue (W256
a, W256
b, W256
c, W256
d, W256
e, W256
f)
  (Maybe W256, Maybe W256, Maybe W256, Maybe W256, Maybe W256,
 Maybe W256)
_ -> do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'EWord
k, Expr 'EWord
l, Expr 'EWord
m, Expr 'EWord
n, Expr 'EWord
o, Expr 'EWord
p]

forceConcreteBuf :: Expr Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf :: Expr 'Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf (ConcreteBuf ByteString
b) String
_ ByteString -> EVM ()
continue = ByteString -> EVM ()
continue ByteString
b
forceConcreteBuf Expr 'Buf
b String
msg ByteString -> EVM ()
_ = do
    VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
    Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
msg [Expr 'Buf
b]

-- * Substate manipulation
refund :: Word64 -> EVM ()
refund :: Word64 -> EVM ()
refund Word64
n = do
  Addr
self <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract)
  forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [(Addr, Word64)]
refunds) (Addr
self, Word64
n)

unRefund :: Word64 -> EVM ()
unRefund :: Word64 -> EVM ()
unRefund Word64
n = do
  Addr
self <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract)
  [(Addr, Word64)]
refs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [(Addr, Word64)]
refunds)
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [(Addr, Word64)]
refunds)
    (forall a. (a -> Bool) -> [a] -> [a]
filter (\(Addr
a,Word64
b) -> Bool -> Bool
not (Addr
a forall a. Eq a => a -> a -> Bool
== Addr
self Bool -> Bool -> Bool
&& Word64
b forall a. Eq a => a -> a -> Bool
== Word64
n)) [(Addr, Word64)]
refs)

touchAccount :: Addr -> EVM()
touchAccount :: Addr -> EVM ()
touchAccount = forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo ((Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [Addr]
touchedAccounts)

selfdestruct :: Addr -> EVM()
selfdestruct :: Addr -> EVM ()
selfdestruct = forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo ((Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [Addr]
selfdestructs)

accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn Addr
x EVM ()
cont = do
  FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
..} <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ( Lens' VM Block
block forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Block (FeeSchedule Word64)
schedule )
  Bool
acc <- Addr -> EVM Bool
accessAccountForGas Addr
x
  let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
  Word64 -> EVM () -> EVM ()
burn Word64
cost EVM ()
cont

-- | returns a wrapped boolean- if true, this address has been touched before in the txn (warm gas cost as in EIP 2929)
-- otherwise cold
accessAccountForGas :: Addr -> EVM Bool
accessAccountForGas :: Addr -> EVM Bool
accessAccountForGas Addr
addr = do
  Set Addr
accessedAddrs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState (Set Addr)
accessedAddresses)
  let accessed :: Bool
accessed = forall a. Ord a => a -> Set a -> Bool
member Addr
addr Set Addr
accessedAddrs
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState (Set Addr)
accessedAddresses) (forall a. Ord a => a -> Set a -> Set a
insert Addr
addr Set Addr
accessedAddrs)
  forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: Addr -> Expr EWord -> EVM Bool
accessStorageForGas :: Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
addr Expr 'EWord
key = do
  Set (Addr, W256)
accessedStrkeys <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState (Set (Addr, W256))
accessedStorageKeys)
  case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
key of
    Just W256
litword -> do
      let accessed :: Bool
accessed = forall a. Ord a => a -> Set a -> Bool
member (Addr
addr, W256
litword) Set (Addr, W256)
accessedStrkeys
      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState (Set (Addr, W256))
accessedStorageKeys) (forall a. Ord a => a -> Set a -> Set a
insert (Addr
addr, W256
litword) Set (Addr, W256)
accessedStrkeys)
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
accessed
    Maybe W256
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- * Cheat codes

-- The cheat code is 7109709ecfa91a80626ff3989d68f67f5b1dd12d.
-- Call this address using one of the cheatActions below to do
-- special things, e.g. changing the block timestamp. Beware that
-- these are necessarily hevm specific.
cheatCode :: Addr
cheatCode :: Addr
cheatCode = forall a b. (Integral a, Num b) => a -> b
num (ByteString -> W256
keccak' ByteString
"hevm cheat code")

cheat
  :: (?op :: Word8)
  => (W256, W256) -> (W256, W256)
  -> EVM ()
cheat :: (?op::Word8) => (W256, W256) -> (W256, W256) -> EVM ()
cheat (W256
inOffset, W256
inSize) (W256
outOffset, W256
outSize) = do
  Expr 'Buf
mem <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory)
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
  let
    abi :: Expr 'EWord
abi = Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
inOffset) Expr 'Buf
mem
    input :: Expr 'Buf
input = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit forall a b. (a -> b) -> a -> b
$ W256
inOffset forall a. Num a => a -> a -> a
+ W256
4) (W256 -> Expr 'EWord
Lit forall a b. (a -> b) -> a -> b
$ W256
inSize forall a. Num a => a -> a -> a
- W256
4) VM
vm
  case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
abi of
    Maybe W256
Nothing -> Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm._state._pc String
"symbolic cheatcode selector" [Expr 'EWord
abi]
    Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
abi') ->
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32
abi' Map Word32 CheatAction
cheatActions of
        Maybe CheatAction
Nothing ->
          Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode (forall a. a -> Maybe a
Just Word32
abi'))
        Just CheatAction
action -> do
            CheatAction
action (W256 -> Expr 'EWord
Lit W256
outOffset) (W256 -> Expr 'EWord
Lit W256
outSize) Expr 'Buf
input
            (?op::Word8) => EVM ()
next
            W256 -> EVM ()
push W256
1

type CheatAction = Expr EWord -> Expr EWord -> Expr Buf -> EVM ()

cheatActions :: Map Word32 CheatAction
cheatActions :: Map Word32 CheatAction
cheatActions =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"ffi(string[])" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
outOffset Expr 'EWord
outSize Expr 'Buf
input -> do
          VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
          if VM
vm._allowFFI then
            case [AbiType] -> Expr 'Buf -> AbiVals
decodeBuf [AbiType -> AbiType
AbiArrayDynamicType AbiType
AbiStringType] Expr 'Buf
input of
              CAbi [AbiValue]
valsArr -> case [AbiValue]
valsArr of
                [AbiArrayDynamic AbiType
AbiStringType Vector AbiValue
strsV] ->
                  let
                    cmd :: [String]
cmd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            (\case
                              (AbiString ByteString
a) -> Text -> String
unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
a
                              AbiValue
_ -> String
"")
                            (forall a. Vector a -> [a]
V.toList Vector AbiValue
strsV)
                    cont :: ByteString -> EVM ()
cont ByteString
bs = do
                      let encoded :: Expr 'Buf
encoded = ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
encoded
                      Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
encoded Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
                      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall a. Maybe a
Nothing
                  in forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query forall a b. (a -> b) -> a -> b
$ ([String] -> (ByteString -> EVM ()) -> Query
PleaseDoFFI [String]
cmd ByteString -> EVM ()
cont))
                [AbiValue]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig)
              AbiVals
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig)
          else
            let msg :: ByteString
msg = Text -> ByteString
encodeUtf8 Text
"ffi disabled: run again with --ffi if you want to allow tests to call external scripts"
            in Error -> EVM ()
vmError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> Error
EVM.Revert forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expr 'Buf
ConcreteBuf forall a b. (a -> b) -> a -> b
$
              Text -> AbiValue -> ByteString
abiMethod Text
"Error(string)" (Vector AbiValue -> AbiValue
AbiTuple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ [ByteString -> AbiValue
AbiString ByteString
msg]),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"warp(uint256)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
x]  -> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Block
block forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Block (Expr 'EWord)
timestamp) Expr 'EWord
x
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"roll(uint256)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
x] -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x String
"cannot roll to a symbolic block number" (forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Block
block forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Block W256
number))
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"store(address,bytes32,bytes32)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
3 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
slot, Expr 'EWord
new] ->
            Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
a String
"cannot store at a symbolic address" forall a b. (a -> b) -> a -> b
$ \(forall a b. (Integral a, Num b) => a -> b
num -> Addr
a') ->
              Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
a' forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
a') Expr 'EWord
slot Expr 'EWord
new)
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"load(address,bytes32)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
slot] ->
            Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
a String
"cannot load from a symbolic address" forall a b. (a -> b) -> a -> b
$ \(forall a b. (Integral a, Num b) => a -> b
num -> Addr
a') ->
              Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
a' Expr 'EWord
slot forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
res -> do
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
Expr 'EWord
-> (Expr 'EWord -> f (Expr 'EWord)) -> Expr 'Buf -> f (Expr 'Buf)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
res
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
Expr 'EWord
-> (Expr 'EWord -> f (Expr 'EWord)) -> Expr 'Buf -> f (Expr 'Buf)
word256At Expr 'EWord
outOffset) Expr 'EWord
res
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"sign(uint256,bytes32)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
sk, Expr 'EWord
hash] ->
            (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
sk, Expr 'EWord
hash) String
"cannot sign symbolic data" forall a b. (a -> b) -> a -> b
$ \(W256
sk', W256
hash') -> do
              let (Word8
v,W256
r,W256
s) = W256 -> Integer -> (Word8, W256, W256)
EVM.Sign.sign W256
hash' (forall a. Integral a => a -> Integer
toInteger W256
sk')
                  encoded :: ByteString
encoded = AbiValue -> ByteString
encodeAbiValue forall a b. (a -> b) -> a -> b
$
                    Vector AbiValue -> AbiValue
AbiTuple (forall a. [a] -> Vector a
RegularVector.fromList
                      [ Int -> Word256 -> AbiValue
AbiUInt Int
8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
num Word8
v
                      , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
r)
                      , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
s)
                      ])
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded)
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded) (W256 -> Expr 'EWord
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
num forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length forall a b. (a -> b) -> a -> b
$ ByteString
encoded) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"addr(uint256)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
sk] -> Expr 'EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
sk String
"cannot derive address for a symbolic key" forall a b. (a -> b) -> a -> b
$ \W256
sk' -> do
            let a :: Maybe Addr
a = Integer -> Maybe Addr
EVM.Sign.deriveAddr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
num W256
sk'
            case Maybe Addr
a of
              Maybe Addr
Nothing -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig)
              Just Addr
address -> do
                let expAddr :: Expr 'EWord
expAddr = Addr -> Expr 'EWord
litAddr Addr
address
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
Expr 'EWord
-> (Expr 'EWord -> f (Expr 'EWord)) -> Expr 'Buf -> f (Expr 'Buf)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
expAddr
                forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
Expr 'EWord
-> (Expr 'EWord -> f (Expr 'EWord)) -> Expr 'Buf -> f (Expr 'Buf)
word256At Expr 'EWord
outOffset) Expr 'EWord
expAddr
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      forall {b}. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"prank(address)" forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
addr]  -> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe (Expr 'EWord))
overrideCaller (forall a. a -> Maybe a
Just Expr 'EWord
addr)
          [Expr 'EWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig)

    ]
  where
    action :: ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
s Maybe Word32 -> b
f = (ByteString -> Word32
abiKeccak ByteString
s, Maybe Word32 -> b
f (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Word32
abiKeccak ByteString
s))

-- | We don't wanna introduce the machinery needed to sign with a random nonce,
-- so we just use the same nonce every time (420). This is obviusly very
-- insecure, but fine for testing purposes.
ethsign :: PrivateKey -> Digest Crypto.Keccak_256 -> Signature
ethsign :: PrivateKey -> Digest Keccak_256 -> Signature
ethsign PrivateKey
sk Digest Keccak_256
digest = Integer -> Signature
go Integer
420
  where
    go :: Integer -> Signature
go Integer
k = case forall hash.
HashAlgorithm hash =>
Integer -> PrivateKey -> Digest hash -> Maybe Signature
signDigestWith Integer
k PrivateKey
sk Digest Keccak_256
digest of
       Maybe Signature
Nothing  -> Integer -> Signature
go (Integer
k forall a. Num a => a -> a -> a
+ Integer
1)
       Just Signature
sig -> Signature
sig

-- * General call implementation ("delegateCall")
-- note that the continuation is ignored in the precompile case
delegateCall
  :: (?op :: Word8)
  => Contract -> Word64 -> Expr EWord -> Expr EWord -> W256 -> W256 -> W256 -> W256 -> W256
  -> [Expr EWord]
  -> (Addr -> EVM ())
  -> EVM ()
delegateCall :: (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word64
gasGiven Expr 'EWord
xTo Expr 'EWord
xContext W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs Addr -> EVM ()
continue =
  (Expr 'EWord, Expr 'EWord)
-> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xTo, Expr 'EWord
xContext) String
"cannot delegateCall with symbolic target or context" forall a b. (a -> b) -> a -> b
$
    \((forall a b. (Integral a, Num b) => a -> b
num -> Addr
xTo'), (forall a b. (Integral a, Num b) => a -> b
num -> Addr
xContext')) ->
      if Addr
xTo' forall a. Ord a => a -> a -> Bool
> Addr
0 Bool -> Bool -> Bool
&& Addr
xTo' forall a. Ord a => a -> a -> Bool
<= Addr
9
      then (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
precompiledContract Contract
this Word64
gasGiven Addr
xTo' Addr
xContext' W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs
      else if Addr
xTo' forall a. Eq a => a -> a -> Bool
== Addr
cheatCode then
        do
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) [Expr 'EWord]
xs
          (?op::Word8) => (W256, W256) -> (W256, W256) -> EVM ()
cheat (W256
xInOffset, W256
xInSize) (W256
xOutOffset, W256
xOutSize)
      else
        (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
gasGiven Addr
xContext' Addr
xTo' W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall a b. (a -> b) -> a -> b
$
        \Word64
xGas -> do
          VM
vm0 <- forall s (m :: * -> *). MonadState s m => m s
get
          Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
xTo' forall a b. (a -> b) -> a -> b
$ \Contract
target ->
                Word64 -> EVM () -> EVM ()
burn Word64
xGas forall a b. (a -> b) -> a -> b
$ do
                  let newContext :: FrameContext
newContext = CallContext
                                    { $sel:callContextTarget:CreationContext :: Addr
callContextTarget    = Addr
xTo'
                                    , $sel:callContextContext:CreationContext :: Addr
callContextContext   = Addr
xContext'
                                    , $sel:callContextOffset:CreationContext :: W256
callContextOffset    = W256
xOutOffset
                                    , $sel:callContextSize:CreationContext :: W256
callContextSize      = W256
xOutSize
                                    , $sel:callContextCodehash:CreationContext :: Expr 'EWord
callContextCodehash  = Contract
target._codehash
                                    , $sel:callContextReversion:CreationContext :: (Map Addr Contract, Expr 'Storage)
callContextReversion = (VM
vm0._env._contracts, VM
vm0._env._storage)
                                    , $sel:callContextSubState:CreationContext :: SubState
callContextSubState  = VM
vm0._tx._substate
                                    , $sel:callContextAbi:CreationContext :: Maybe W256
callContextAbi =
                                        if W256
xInSize forall a. Ord a => a -> a -> Bool
>= W256
4
                                        then case Expr 'EWord -> Maybe W256
unlit forall a b. (a -> b) -> a -> b
$ Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
xInOffset) VM
vm0._state._memory
                                             of Maybe W256
Nothing -> forall a. Maybe a
Nothing
                                                Just W256
abi -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
num W256
abi
                                        else forall a. Maybe a
Nothing
                                    , $sel:callContextData:CreationContext :: Expr 'Buf
callContextData = (Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit W256
xInOffset) (W256 -> Expr 'EWord
Lit W256
xInSize) VM
vm0)
                                    }

                  TraceData -> EVM ()
pushTrace (FrameContext -> TraceData
FrameTrace FrameContext
newContext)
                  (?op::Word8) => EVM ()
next
                  VM
vm1 <- forall s (m :: * -> *). MonadState s m => m s
get

                  forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo Lens' VM [Frame]
frames forall a b. (a -> b) -> a -> b
$ Frame
                    { $sel:_frameState:Frame :: FrameState
_frameState = VM
vm1._state { $sel:_stack:FrameState :: [Expr 'EWord]
_stack = [Expr 'EWord]
xs }
                    , $sel:_frameContext:Frame :: FrameContext
_frameContext = FrameContext
newContext
                    }

                  let clearInitCode :: ContractCode -> ContractCode
clearInitCode = \case
                        (InitCode ByteString
_ Expr 'Buf
_) -> ByteString -> Expr 'Buf -> ContractCode
InitCode forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
                        ContractCode
a -> ContractCode
a

                  forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' VM FrameState
state forall a b. (a -> b) -> a -> b
$ do
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Word64
gas (forall a b. (Integral a, Num b) => a -> b
num Word64
xGas)
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Int
pc Int
0
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState ContractCode
code (ContractCode -> ContractCode
clearInitCode Contract
target._contractcode)
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Addr
codeContract Addr
xTo'
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState [Expr 'EWord]
stack forall a. Monoid a => a
mempty
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'Buf)
memory forall a. Monoid a => a
mempty
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState Word64
memorySize Word64
0
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'Buf)
returndata forall a. Monoid a => a
mempty
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' FrameState (Expr 'Buf)
calldata (Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice (W256 -> Expr 'EWord
Lit W256
xInOffset) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
xInSize) VM
vm0._state._memory forall a. Monoid a => a
mempty)

                  Addr -> EVM ()
continue Addr
xTo'

-- -- * Contract creation

-- EIP 684
collision :: Maybe Contract -> Bool
collision :: Maybe Contract -> Bool
collision Maybe Contract
c' = case Maybe Contract
c' of
  Just Contract
c -> Contract
c._nonce forall a. Eq a => a -> a -> Bool
/= W256
0 Bool -> Bool -> Bool
|| case Contract
c._contractcode of
    RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
False
    RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
b) -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector (Expr 'Byte)
b
    ContractCode
_ -> Bool
True
  Maybe Contract
Nothing -> Bool
False

create :: (?op :: Word8)
  => Addr -> Contract
  -> Word64 -> W256 -> [Expr EWord] -> Addr -> Expr Buf -> EVM ()
create :: (?op::Word8) =>
Addr
-> Contract
-> Word64
-> W256
-> [Expr 'EWord]
-> Addr
-> Expr 'Buf
-> EVM ()
create Addr
self Contract
this Word64
xGas' W256
xValue [Expr 'EWord]
xs Addr
newAddr Expr 'Buf
initCode = do
  VM
vm0 <- forall s (m :: * -> *). MonadState s m => m s
get
  let xGas :: Word64
xGas = forall a b. (Integral a, Num b) => a -> b
num Word64
xGas'
  if Contract
this._nonce forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
num (forall a. Bounded a => a
maxBound :: Word64)
  then do
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
NonceOverflow
    (?op::Word8) => EVM ()
next
  else if W256
xValue forall a. Ord a => a -> a -> Bool
> Contract
this._balance
  then do
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> Error
BalanceTooLow W256
xValue Contract
this._balance
    (?op::Word8) => EVM ()
next
  else if forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm0._frames forall a. Ord a => a -> a -> Bool
>= Int
1024
  then do
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
CallDepthLimitReached
    (?op::Word8) => EVM ()
next
  else if Maybe Contract -> Bool
collision forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
newAddr VM
vm0._env._contracts
  then Word64 -> EVM () -> EVM ()
burn Word64
xGas forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) (W256 -> Expr 'EWord
Lit W256
0 forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
self forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract W256
nonce) forall a. Enum a => a -> a
succ
    (?op::Word8) => EVM ()
next
  else Word64 -> EVM () -> EVM ()
burn Word64
xGas forall a b. (a -> b) -> a -> b
$ do
    Addr -> EVM ()
touchAccount Addr
self
    Addr -> EVM ()
touchAccount Addr
newAddr
    let
    -- unfortunately we have to apply some (pretty hacky)
    -- heuristics here to parse the unstructured buffer read
    -- from memory into a code and data section
    -- TODO: comment explaining whats going on here
    let contract' :: Maybe ContractCode
contract' = do
          Integer
prefixLen <- Expr 'Buf -> Maybe Integer
Expr.concPrefix Expr 'Buf
initCode
          Vector (Expr 'Byte)
prefix <- Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'Buf -> Expr 'Buf
Expr.take (forall a b. (Integral a, Num b) => a -> b
num Integer
prefixLen) Expr 'Buf
initCode
          let sym :: Expr 'Buf
sym = W256 -> Expr 'Buf -> Expr 'Buf
Expr.drop (forall a b. (Integral a, Num b) => a -> b
num Integer
prefixLen) Expr 'Buf
initCode
          Vector Word8
conc <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr 'Byte -> Maybe Word8
unlitByte Vector (Expr 'Byte)
prefix
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf -> ContractCode
InitCode ([Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector Word8
conc) Expr 'Buf
sym
    case Maybe ContractCode
contract' of
      Maybe ContractCode
Nothing ->
        Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg VM
vm0._state._pc String
"initcode must have a concrete prefix" []
      Just ContractCode
c -> do
        let
          newContract :: Contract
newContract = ContractCode -> Contract
initialContract ContractCode
c
          newContext :: FrameContext
newContext  =
            CreationContext { $sel:creationContextAddress:CreationContext :: Addr
creationContextAddress   = Addr
newAddr
                            , $sel:creationContextCodehash:CreationContext :: Expr 'EWord
creationContextCodehash  = Contract
newContract._codehash
                            , $sel:creationContextReversion:CreationContext :: Map Addr Contract
creationContextReversion = VM
vm0._env._contracts
                            , $sel:creationContextSubstate:CreationContext :: SubState
creationContextSubstate  = VM
vm0._tx._substate
                            }

        forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts) forall a b. (a -> b) -> a -> b
$ do
          Maybe (IxValue (Map Addr Contract))
oldAcc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
newAddr)
          let oldBal :: W256
oldBal = forall b a. b -> (a -> b) -> Maybe a -> b
maybe W256
0 (._balance) Maybe (IxValue (Map Addr Contract))
oldAcc

          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
newAddr) (forall a. a -> Maybe a
Just (Contract
newContract forall a b. a -> (a -> b) -> b
& Lens' Contract W256
balance forall s t a b. ASetter s t a b -> b -> s -> t
.~ W256
oldBal))
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
self forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract W256
nonce) forall a. Enum a => a -> a
succ

        let resetStorage :: Expr 'Storage -> Expr 'Storage
resetStorage = \case
              ConcreteStore Map W256 (Map W256 W256)
s -> Map W256 (Map W256 W256) -> Expr 'Storage
ConcreteStore (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall a b. (Integral a, Num b) => a -> b
num Addr
newAddr) Map W256 (Map W256 W256)
s)
              Expr 'Storage
AbstractStore -> Expr 'Storage
AbstractStore
              Expr 'Storage
EmptyStore -> Expr 'Storage
EmptyStore
              SStore {} -> forall a. HasCallStack => String -> a
error String
"trying to reset symbolic storage with writes in create"
              GVar GVar 'Storage
_  -> forall a. HasCallStack => String -> a
error String
"unexpected global variable"

        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage) Expr 'Storage -> Expr 'Storage
resetStorage
        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map W256 (Map W256 W256))
origStorage) (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall a b. (Integral a, Num b) => a -> b
num Addr
newAddr))

        Addr -> Addr -> W256 -> EVM ()
transfer Addr
self Addr
newAddr W256
xValue

        TraceData -> EVM ()
pushTrace (FrameContext -> TraceData
FrameTrace FrameContext
newContext)
        (?op::Word8) => EVM ()
next
        VM
vm1 <- forall s (m :: * -> *). MonadState s m => m s
get
        forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo Lens' VM [Frame]
frames forall a b. (a -> b) -> a -> b
$ Frame
          { $sel:_frameContext:Frame :: FrameContext
_frameContext = FrameContext
newContext
          , $sel:_frameState:Frame :: FrameState
_frameState   = VM
vm1._state { $sel:_stack:FrameState :: [Expr 'EWord]
_stack = [Expr 'EWord]
xs }
          }

        forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM FrameState
state forall a b. (a -> b) -> a -> b
$
          FrameState
blankState
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FrameState Addr
contract   Addr
newAddr
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FrameState Addr
codeContract Addr
newAddr
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FrameState ContractCode
code       ContractCode
c
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FrameState (Expr 'EWord)
callvalue  (W256 -> Expr 'EWord
Lit W256
xValue)
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FrameState (Expr 'EWord)
caller     (Addr -> Expr 'EWord
litAddr Addr
self)
            forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FrameState Word64
gas        Word64
xGas'

-- | Replace a contract's code, like when CREATE returns
-- from the constructor code.
replaceCode :: Addr -> ContractCode -> EVM ()
replaceCode :: Addr -> ContractCode -> EVM ()
replaceCode Addr
target ContractCode
newCode =
  forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Addr
target) forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Contract
now -> case Contract
now._contractcode of
        InitCode ByteString
_ Expr 'Buf
_ ->
          forall s (m :: * -> *). MonadState s m => s -> m ()
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            (ContractCode -> Contract
initialContract ContractCode
newCode)
              { $sel:_balance:Contract :: W256
_balance = Contract
now._balance
              , $sel:_nonce:Contract :: W256
_nonce = Contract
now._nonce
              }
        RuntimeCode RuntimeCode
_ ->
          forall a. HasCallStack => String -> a
error (String
"internal error: can't replace code of deployed contract " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Addr
target)
      Maybe Contract
Nothing ->
        forall a. HasCallStack => String -> a
error String
"internal error: can't replace code of nonexistent contract"

replaceCodeOfSelf :: ContractCode -> EVM ()
replaceCodeOfSelf :: ContractCode -> EVM ()
replaceCodeOfSelf ContractCode
newCode = do
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
  Addr -> ContractCode -> EVM ()
replaceCode VM
vm._state._contract ContractCode
newCode

resetState :: EVM ()
resetState :: EVM ()
resetState = do
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall a. Maybe a
Nothing
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM [Frame]
frames []
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM FrameState
state  FrameState
blankState


-- * VM error implementation

vmError :: Error -> EVM ()
vmError :: Error -> EVM ()
vmError Error
e = FrameResult -> EVM ()
finishFrame (Error -> FrameResult
FrameErrored Error
e)

underrun :: EVM ()
underrun :: EVM ()
underrun = Error -> EVM ()
vmError Error
EVM.StackUnderrun

-- | A stack frame can be popped in three ways.
data FrameResult
  = FrameReturned (Expr Buf) -- ^ STOP, RETURN, or no more code
  | FrameReverted (Expr Buf) -- ^ REVERT
  | FrameErrored Error -- ^ Any other error
  deriving Int -> FrameResult -> ShowS
[FrameResult] -> ShowS
FrameResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameResult] -> ShowS
$cshowList :: [FrameResult] -> ShowS
show :: FrameResult -> String
$cshow :: FrameResult -> String
showsPrec :: Int -> FrameResult -> ShowS
$cshowsPrec :: Int -> FrameResult -> ShowS
Show

-- | This function defines how to pop the current stack frame in either of
-- the ways specified by 'FrameResult'.
--
-- It also handles the case when the current stack frame is the only one;
-- in this case, we set the final '_result' of the VM execution.
finishFrame :: FrameResult -> EVM ()
finishFrame :: FrameResult -> EVM ()
finishFrame FrameResult
how = do
  VM
oldVm <- forall s (m :: * -> *). MonadState s m => m s
get

  case VM
oldVm._frames of
    -- Is the current frame the only one?
    [] -> do
      case FrameResult
how of
          FrameReturned Expr 'Buf
output -> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> VMResult
VMSuccess Expr 'Buf
output
          FrameReverted Expr 'Buf
buffer -> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Error -> VMResult
VMFailure (Expr 'Buf -> Error
EVM.Revert Expr 'Buf
buffer)
          FrameErrored Error
e       -> forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM (Maybe VMResult)
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Error -> VMResult
VMFailure Error
e
      EVM ()
finalize

    -- Are there some remaining frames?
    Frame
nextFrame : [Frame]
remainingFrames -> do

      -- Insert a debug trace.
      TraceData -> EVM ()
insertTrace forall a b. (a -> b) -> a -> b
$
        case FrameResult
how of
          FrameErrored Error
e ->
            Error -> TraceData
ErrorTrace Error
e
          FrameReverted Expr 'Buf
e ->
            Error -> TraceData
ErrorTrace (Expr 'Buf -> Error
EVM.Revert Expr 'Buf
e)
          FrameReturned Expr 'Buf
output ->
            Expr 'Buf -> FrameContext -> TraceData
ReturnTrace Expr 'Buf
output Frame
nextFrame._frameContext
      -- Pop to the previous level of the debug trace stack.
      EVM ()
popTrace

      -- Pop the top frame.
      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM [Frame]
frames [Frame]
remainingFrames
      -- Install the state of the frame to which we shall return.
      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' VM FrameState
state Frame
nextFrame._frameState

      -- When entering a call, the gas allowance is counted as burned
      -- in advance; this unburns the remainder and adds it to the
      -- parent frame.
      let remainingGas :: Word64
remainingGas = VM
oldVm._state._gas
          reclaimRemainingGasAllowance :: EVM ()
reclaimRemainingGasAllowance = do
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' VM Word64
burned (forall a. Num a => a -> a -> a
subtract Word64
remainingGas)
            forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
gas) (forall a. Num a => a -> a -> a
+ Word64
remainingGas)

      -- Now dispatch on whether we were creating or calling,
      -- and whether we shall return, revert, or error (six cases).
      case Frame
nextFrame._frameContext of

        -- Were we calling?
        CallContext Addr
_ Addr
_ (W256 -> Expr 'EWord
Lit -> Expr 'EWord
outOffset) (W256 -> Expr 'EWord
Lit -> Expr 'EWord
outSize) Expr 'EWord
_ Maybe W256
_ Expr 'Buf
_ (Map Addr Contract, Expr 'Storage)
reversion SubState
substate' -> do

          -- Excerpt K.1. from the yellow paper:
          -- K.1. Deletion of an Account Despite Out-of-gas.
          -- At block 2675119, in the transaction 0xcf416c536ec1a19ed1fb89e4ec7ffb3cf73aa413b3aa9b77d60e4fd81a4296ba,
          -- an account at address 0x03 was called and an out-of-gas occurred during the call.
          -- 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
          [Addr]
touched <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SubState [Addr]
touchedAccounts)

          let
            substate'' :: SubState
substate'' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SubState [Addr]
touchedAccounts (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall s a. Cons s s a a => a -> s -> s
cons (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Addr
3 ==) [Addr]
touched)) SubState
substate'
            (Map Addr Contract
contractsReversion, Expr 'Storage
storageReversion) = (Map Addr Contract, Expr 'Storage)
reversion
            revertContracts :: EVM ()
revertContracts = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts) Map Addr Contract
contractsReversion
            revertStorage :: EVM ()
revertStorage = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Expr 'Storage)
storage) Expr 'Storage
storageReversion
            revertSubstate :: EVM ()
revertSubstate  = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate) SubState
substate''

          case FrameResult
how of
            -- Case 1: Returning from a call?
            FrameReturned Expr 'Buf
output -> do
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
output
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
output Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
              EVM ()
reclaimRemainingGasAllowance
              W256 -> EVM ()
push W256
1

            -- Case 2: Reverting during a call?
            FrameReverted Expr 'Buf
output -> do
              EVM ()
revertContracts
              EVM ()
revertStorage
              EVM ()
revertSubstate
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
output
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
output Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
              EVM ()
reclaimRemainingGasAllowance
              W256 -> EVM ()
push W256
0

            -- Case 3: Error during a call?
            FrameErrored Error
_ -> do
              EVM ()
revertContracts
              EVM ()
revertStorage
              EVM ()
revertSubstate
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
              W256 -> EVM ()
push W256
0
        -- Or were we creating?
        CreationContext Addr
_ Expr 'EWord
_ Map Addr Contract
reversion SubState
substate' -> do
          Addr
creator <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
contract)
          let
            createe :: Addr
createe = VM
oldVm._state._contract
            revertContracts :: EVM ()
revertContracts = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts) Map Addr Contract
reversion'
            revertSubstate :: EVM ()
revertSubstate  = forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM TxState
tx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TxState SubState
substate) SubState
substate'

            -- persist the nonce through the reversion
            reversion' :: Map Addr Contract
reversion' = (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Contract W256
nonce (forall a. Num a => a -> a -> a
+ W256
1)) Addr
creator) Map Addr Contract
reversion

          case FrameResult
how of
            -- Case 4: Returning during a creation?
            FrameReturned Expr 'Buf
output -> do
              let onContractCode :: ContractCode -> EVM ()
onContractCode ContractCode
contractCode = do
                    Addr -> ContractCode -> EVM ()
replaceCode Addr
createe ContractCode
contractCode
                    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
                    EVM ()
reclaimRemainingGasAllowance
                    W256 -> EVM ()
push (forall a b. (Integral a, Num b) => a -> b
num Addr
createe)
              case Expr 'Buf
output of
                ConcreteBuf ByteString
bs ->
                  ContractCode -> EVM ()
onContractCode forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
bs)
                Expr 'Buf
_ ->
                  case Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList Expr 'Buf
output of
                    Maybe (Vector (Expr 'Byte))
Nothing -> Error -> EVM ()
vmError forall a b. (a -> b) -> a -> b
$
                      forall (a :: EType). Int -> String -> [Expr a] -> Error
UnexpectedSymbolicArg
                        VM
oldVm._state._pc
                        String
"runtime code cannot have an abstract length"
                        [Expr 'Buf
output]
                    Just Vector (Expr 'Byte)
newCode -> do
                      ContractCode -> EVM ()
onContractCode forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
newCode)

            -- Case 5: Reverting during a creation?
            FrameReverted Expr 'Buf
output -> do
              EVM ()
revertContracts
              EVM ()
revertSubstate
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) Expr 'Buf
output
              EVM ()
reclaimRemainingGasAllowance
              W256 -> EVM ()
push W256
0

            -- Case 6: Error during a creation?
            FrameErrored Error
_ -> do
              EVM ()
revertContracts
              EVM ()
revertSubstate
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
returndata) forall a. Monoid a => a
mempty
              W256 -> EVM ()
push W256
0


-- * Memory helpers

accessUnboundedMemoryRange
  :: Word64
  -> Word64
  -> EVM ()
  -> EVM ()
accessUnboundedMemoryRange :: Word64 -> Word64 -> EVM () -> EVM ()
accessUnboundedMemoryRange Word64
_ Word64
0 EVM ()
continue = EVM ()
continue
accessUnboundedMemoryRange Word64
f Word64
l EVM ()
continue = do
  Word64
m0 <- forall a b. (Integral a, Num b) => a -> b
num forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
memorySize)
  FeeSchedule Word64
fees <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (._block._schedule)
  do
    let m1 :: Word64
m1 = Word64
32 forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a. Ord a => a -> a -> a
max Word64
m0 (Word64
f forall a. Num a => a -> a -> a
+ Word64
l)) Word64
32
    Word64 -> EVM () -> EVM ()
burn (FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m1 forall a. Num a => a -> a -> a
- FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m0) forall a b. (a -> b) -> a -> b
$ do
      forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Word64
memorySize) Word64
m1
      EVM ()
continue

accessMemoryRange
  :: W256
  -> W256
  -> EVM ()
  -> EVM ()
accessMemoryRange :: W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
_ W256
0 EVM ()
continue = EVM ()
continue
accessMemoryRange W256
f W256
l EVM ()
continue =
  case (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> W256 -> Maybe Word64
toWord64 W256
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> W256 -> Maybe Word64
toWord64 W256
l of
    Maybe (Word64, Word64)
Nothing -> Error -> EVM ()
vmError Error
IllegalOverflow
    Just (Word64
f64, Word64
l64) ->
      if Word64
f64 forall a. Num a => a -> a -> a
+ Word64
l64 forall a. Ord a => a -> a -> Bool
< Word64
l64
        then Error -> EVM ()
vmError Error
IllegalOverflow
        else Word64 -> Word64 -> EVM () -> EVM ()
accessUnboundedMemoryRange Word64
f64 Word64
l64 EVM ()
continue

accessMemoryWord
  :: W256 -> EVM () -> EVM ()
accessMemoryWord :: W256 -> EVM () -> EVM ()
accessMemoryWord W256
x = W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
x W256
32

copyBytesToMemory
  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM ()
copyBytesToMemory :: Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
xOffset Expr 'EWord
yOffset =
  if Expr 'EWord
size forall a. Eq a => a -> a -> Bool
== (W256 -> Expr 'EWord
Lit W256
0) then forall (m :: * -> *). Monad m => m ()
noop
  else do
    Expr 'Buf
mem <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory)
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory) forall a b. (a -> b) -> a -> b
$
      Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
xOffset Expr 'EWord
yOffset Expr 'EWord
size Expr 'Buf
bs Expr 'Buf
mem

copyCallBytesToMemory
  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM ()
copyCallBytesToMemory :: Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
xOffset Expr 'EWord
yOffset =
  if Expr 'EWord
size forall a. Eq a => a -> a -> Bool
== (W256 -> Expr 'EWord
Lit W256
0) then forall (m :: * -> *). Monad m => m ()
noop
  else do
    Expr 'Buf
mem <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory)
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState (Expr 'Buf)
memory) forall a b. (a -> b) -> a -> b
$
      Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
xOffset Expr 'EWord
yOffset (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.min Expr 'EWord
size (Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
bs)) Expr 'Buf
bs Expr 'Buf
mem

readMemory :: Expr EWord -> Expr EWord -> VM -> Expr Buf
readMemory :: Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
offset Expr 'EWord
size VM
vm = Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
offset (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
size VM
vm._state._memory forall a. Monoid a => a
mempty

-- * Tracing

withTraceLocation :: TraceData -> EVM Trace
withTraceLocation :: TraceData -> EVM Trace
withTraceLocation TraceData
x = do
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
  let this :: Contract
this = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ VM -> Maybe Contract
currentContract VM
vm
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace
    { $sel:_traceData:Trace :: TraceData
_traceData = TraceData
x
    , $sel:_traceContract:Trace :: Contract
_traceContract = Contract
this
    , $sel:_traceOpIx:Trace :: Int
_traceOpIx = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ Contract
this._opIxMap forall a. Storable a => Vector a -> Int -> Maybe a
Vector.!? VM
vm._state._pc
    }

pushTrace :: TraceData -> EVM ()
pushTrace :: TraceData -> EVM ()
pushTrace TraceData
x = do
  Trace
trace <- TraceData -> EVM Trace
withTraceLocation TraceData
x
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' VM (TreePos Empty Trace)
traces forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> forall a. TreePos Full a -> TreePos Empty a
Zipper.children forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (forall a. a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t

insertTrace :: TraceData -> EVM ()
insertTrace :: TraceData -> EVM ()
insertTrace TraceData
x = do
  Trace
trace <- TraceData -> EVM Trace
withTraceLocation TraceData
x
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' VM (TreePos Empty Trace)
traces forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (forall a. a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t

popTrace :: EVM ()
popTrace :: EVM ()
popTrace =
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' VM (TreePos Empty Trace)
traces forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> case forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
Zipper.parent TreePos Empty Trace
t of
            Maybe (TreePos Full Trace)
Nothing -> forall a. HasCallStack => String -> a
error String
"internal error (trace root)"
            Just TreePos Full Trace
t' -> forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace TreePos Full Trace
t'

zipperRootForest :: Zipper.TreePos Zipper.Empty a -> Forest a
zipperRootForest :: forall a. TreePos Empty a -> Forest a
zipperRootForest TreePos Empty a
z =
  case forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
Zipper.parent TreePos Empty a
z of
    Maybe (TreePos Full a)
Nothing -> forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
Zipper.toForest TreePos Empty a
z
    Just TreePos Full a
z' -> forall a. TreePos Empty a -> Forest a
zipperRootForest (forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace TreePos Full a
z')

traceForest :: VM -> Forest Trace
traceForest :: VM -> Forest Trace
traceForest VM
vm = forall a. TreePos Empty a -> Forest a
zipperRootForest VM
vm._traces

traceTopLog :: [Expr Log] -> EVM ()
traceTopLog :: [Expr 'Log] -> EVM ()
traceTopLog [] = forall (m :: * -> *). Monad m => m ()
noop
traceTopLog ((LogEntry Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics) : [Expr 'Log]
_) = do
  Trace
trace <- TraceData -> EVM Trace
withTraceLocation (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> TraceData
EventTrace Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics)
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens' VM (TreePos Empty Trace)
traces forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace (forall a. Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (forall a. a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t)
traceTopLog ((GVar GVar 'Log
_) : [Expr 'Log]
_) = forall a. HasCallStack => String -> a
error String
"unexpected global variable"

-- * Stack manipulation

push :: W256 -> EVM ()
push :: W256 -> EVM ()
push = Expr 'EWord -> EVM ()
pushSym forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> Expr 'EWord
Lit

pushSym :: Expr EWord -> EVM ()
pushSym :: Expr 'EWord -> EVM ()
pushSym Expr 'EWord
x = Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Expr 'EWord
x :)


stackOp1
  :: (?op :: Word8)
  => Word64
  -> ((Expr EWord) -> (Expr EWord))
  -> EVM ()
stackOp1 :: (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
cost Expr 'EWord -> Expr 'EWord
f =
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Expr 'EWord
x:[Expr 'EWord]
xs) ->
      Word64 -> EVM () -> EVM ()
burn Word64
cost forall a b. (a -> b) -> a -> b
$ do
        (?op::Word8) => EVM ()
next
        let !y :: Expr 'EWord
y = Expr 'EWord -> Expr 'EWord
f Expr 'EWord
x
        Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Expr 'EWord
y forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      EVM ()
underrun

stackOp2
  :: (?op :: Word8)
  => Word64
  -> (((Expr EWord), (Expr EWord)) -> (Expr EWord))
  -> EVM ()
stackOp2 :: (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
cost (Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f =
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs) ->
      Word64 -> EVM () -> EVM ()
burn Word64
cost forall a b. (a -> b) -> a -> b
$ do
        (?op::Word8) => EVM ()
next
        Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f (Expr 'EWord
x, Expr 'EWord
y) forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      EVM ()
underrun

stackOp3
  :: (?op :: Word8)
  => Word64
  -> (((Expr EWord), (Expr EWord), (Expr EWord)) -> (Expr EWord))
  -> EVM ()
stackOp3 :: (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
cost (Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f =
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Expr 'EWord
x:Expr 'EWord
y:Expr 'EWord
z:[Expr 'EWord]
xs) ->
      Word64 -> EVM () -> EVM ()
burn Word64
cost forall a b. (a -> b) -> a -> b
$ do
      (?op::Word8) => EVM ()
next
      Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f (Expr 'EWord
x, Expr 'EWord
y, Expr 'EWord
z) forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      EVM ()
underrun

-- * Bytecode data functions

checkJump :: Int -> [Expr EWord] -> EVM ()
checkJump :: Int -> [Expr 'EWord] -> EVM ()
checkJump Int
x [Expr 'EWord]
xs = do
  ContractCode
theCode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState ContractCode
code)
  Addr
self <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Addr
codeContract)
  Vector (Int, Op)
theCodeOps <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
self forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract (Vector (Int, Op))
codeOps)
  Vector Int
theOpIxMap <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' VM Env
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
contracts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Addr
self forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Contract (Vector Int)
opIxMap)
  let op :: Maybe Word8
op = case ContractCode
theCode of
        InitCode ByteString
ops Expr 'Buf
_ -> ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
ops Int
x
        RuntimeCode (ConcreteRuntimeCode ByteString
ops) -> ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
ops Int
x
        RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) -> Vector (Expr 'Byte)
ops forall a. Vector a -> Int -> Maybe a
V.!? Int
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr 'Byte -> Maybe Word8
unlitByte
  case Maybe Word8
op of
    Maybe Word8
Nothing -> Error -> EVM ()
vmError Error
EVM.BadJumpDestination
    Just Word8
b ->
      if Word8
0x5b forall a. Eq a => a -> a -> Bool
== Word8
b Bool -> Bool -> Bool
&& forall a. GenericOp a
OpJumpdest forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> b
snd (Vector (Int, Op)
theCodeOps forall a. Vector a -> Int -> a
RegularVector.! (Vector Int
theOpIxMap forall a. Storable a => Vector a -> Int -> a
Vector.! forall a b. (Integral a, Num b) => a -> b
num Int
x))
         then do
           Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Expr 'EWord]
xs
           Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Int
pc forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a b. (Integral a, Num b) => a -> b
num Int
x
         else
           Error -> EVM ()
vmError Error
EVM.BadJumpDestination

opSize :: Word8 -> Int
opSize :: Word8 -> Int
opSize Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x7f = forall a b. (Integral a, Num b) => a -> b
num Word8
x forall a. Num a => a -> a -> a
- Int
0x60 forall a. Num a => a -> a -> a
+ Int
2
opSize Word8
_                          = Int
1

--  i of the resulting vector contains the operation index for
-- the program counter value i.  This is needed because source map
-- entries are per operation, not per byte.
mkOpIxMap :: ContractCode -> Vector Int
mkOpIxMap :: ContractCode -> Vector Int
mkOpIxMap (InitCode ByteString
conc Expr 'Buf
_)
  = forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
Vector.create forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
Vector.new (ByteString -> Int
BS.length ByteString
conc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
      -- Loop over the byte string accumulating a vector-mutating action.
      -- This is somewhat obfuscated, but should be fast.
      let (Word8
_, Int
_, Int
_, ST s ()
m) = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (forall {a} {m :: * -> *} {a} {a}.
(Ord a, PrimMonad m, Storable a, Num a, Num a) =>
MVector (PrimState m) a
-> (a, Int, a, m a) -> a -> (a, Int, a, m ())
go MVector s Int
v) (Word8
0 :: Word8, Int
0, Int
0, forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString
conc
      in ST s ()
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v
      where
        -- concrete case
        go :: MVector (PrimState m) a
-> (a, Int, a, m a) -> a -> (a, Int, a, m ())
go MVector (PrimState m) a
v (a
0, !Int
i, !a
j, !m a
m) a
x | a
x forall a. Ord a => a -> a -> Bool
>= a
0x60 Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
<= a
0x7f =
          {- Start of PUSH op. -} (a
x forall a. Num a => a -> a -> a
- a
0x60 forall a. Num a => a -> a -> a
+ a
1, Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (a
1, !Int
i, !a
j, !m a
m) a
_ =
          {- End of PUSH op. -}   (a
0,            Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j forall a. Num a => a -> a -> a
+ a
1, m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (a
0, !Int
i, !a
j, !m a
m) a
_ =
          {- Other op. -}         (a
0,            Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j forall a. Num a => a -> a -> a
+ a
1, m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (a
n, !Int
i, !a
j, !m a
m) a
_ =
          {- PUSH data. -}        (a
n forall a. Num a => a -> a -> a
- a
1,        Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)

mkOpIxMap (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) =
  ContractCode -> Vector Int
mkOpIxMap (ByteString -> Expr 'Buf -> ContractCode
InitCode ByteString
ops forall a. Monoid a => a
mempty) -- a bit hacky

mkOpIxMap (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops))
  = forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
Vector.create forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
Vector.new (forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
      let (Word8
_, Int
_, Int
_, ST s ()
m) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {m :: * -> *} {a} {a}.
(PrimMonad m, Storable a, Num a, Show a) =>
MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector s Int
v) (Word8
0, Int
0, Int
0, forall (m :: * -> *) a. Monad m => a -> m a
return ()) ([Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops)
      in ST s ()
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v
      where
        go :: MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector (PrimState m) a
v (Word8
0, !Int
i, !a
j, !m a
m) Expr 'Byte
x = case Expr 'Byte -> Maybe Word8
unlitByte Expr 'Byte
x of
          Just Word8
x' -> if Word8
x' forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x' forall a. Ord a => a -> a -> Bool
<= Word8
0x7f
            -- start of PUSH op --
                     then (Word8
x' forall a. Num a => a -> a -> a
- Word8
0x60 forall a. Num a => a -> a -> a
+ Word8
1, Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)
            -- other data --
                     else (Word8
0,             Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j forall a. Num a => a -> a -> a
+ a
1, m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)
          Maybe Word8
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"cannot analyze symbolic code:\nx: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Expr 'Byte
x forall a. Semigroup a => a -> a -> a
<> String
" i: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
i forall a. Semigroup a => a -> a -> a
<> String
" j: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
j

        go MVector (PrimState m) a
v (Word8
1, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
          {- End of PUSH op. -}   (Word8
0,            Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j forall a. Num a => a -> a -> a
+ a
1, m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (Word8
n, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
          {- PUSH data. -}        (Word8
n forall a. Num a => a -> a -> a
- Word8
1,        Int
i forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
Vector.write MVector (PrimState m) a
v Int
i a
j)


vmOp :: VM -> Maybe Op
vmOp :: VM -> Maybe Op
vmOp VM
vm =
  let i :: Int
i  = VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState Int
pc
      code' :: ContractCode
code' = VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState ContractCode
code
      (Word8
op, [Expr 'Byte]
pushdata) = case ContractCode
code' of
        InitCode ByteString
xs' Expr 'Buf
_ ->
          (HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        RuntimeCode (ConcreteRuntimeCode ByteString
xs') ->
          (HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
xs') ->
          ( forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"unexpected symbolic code") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Byte -> Maybe Word8
unlitByte forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
xs' forall a. Vector a -> Int -> a
V.! Int
i , forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall a. Int -> Vector a -> Vector a
V.drop Int
i Vector (Expr 'Byte)
xs')
  in if (ContractCode -> Int
opslen ContractCode
code' forall a. Ord a => a -> a -> Bool
< Int
i)
     then forall a. Maybe a
Nothing
     else forall a. a -> Maybe a
Just (Word8 -> [Expr 'Byte] -> Op
readOp Word8
op [Expr 'Byte]
pushdata)

vmOpIx :: VM -> Maybe Int
vmOpIx :: VM -> Maybe Int
vmOpIx VM
vm =
  do Contract
self <- VM -> Maybe Contract
currentContract VM
vm
     Contract
self._opIxMap forall a. Storable a => Vector a -> Int -> Maybe a
Vector.!? VM
vm._state._pc

opParams :: VM -> Map String (Expr EWord)
opParams :: VM -> Map String (Expr 'EWord)
opParams VM
vm =
  case VM -> Maybe Op
vmOp VM
vm of
    Just Op
OpCreate ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"value offset size"
    Just Op
OpCall ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"gas to value in-offset in-size out-offset out-size"
    Just Op
OpSstore ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"index value"
    Just Op
OpCodecopy ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"mem-offset code-offset code-size"
    Just Op
OpSha3 ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"offset size"
    Just Op
OpCalldatacopy ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"to from size"
    Just Op
OpExtcodecopy ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"account mem-offset code-offset code-size"
    Just Op
OpReturn ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"offset size"
    Just Op
OpJumpi ->
      [String] -> Map String (Expr 'EWord)
params forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
"destination condition"
    Maybe Op
_ -> forall a. Monoid a => a
mempty
  where
    params :: [String] -> Map String (Expr 'EWord)
params [String]
xs =
      if forall (t :: * -> *) a. Foldable t => t a -> Int
length (VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack) forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs
      then forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
xs (VM
vm forall s a. s -> Getting a s a -> a
^. Lens' VM FrameState
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FrameState [Expr 'EWord]
stack))
      else forall a. Monoid a => a
mempty

-- Maps operation indicies into a pair of (bytecode index, operation)
mkCodeOps :: ContractCode -> RegularVector.Vector (Int, Op)
mkCodeOps :: ContractCode -> Vector (Int, Op)
mkCodeOps ContractCode
contractCode =
  let l :: [Expr 'Byte]
l = case ContractCode
contractCode of
            InitCode ByteString
bytes Expr 'Buf
_ ->
              Word8 -> Expr 'Byte
LitByte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> [Word8]
BS.unpack ByteString
bytes)
            RuntimeCode (ConcreteRuntimeCode ByteString
ops) ->
              Word8 -> Expr 'Byte
LitByte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> [Word8]
BS.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripBytecodeMetadata ByteString
ops)
            RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
              [Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops
  in forall a. [a] -> Vector a
RegularVector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Int -> [Expr 'Byte] -> Seq (Int, Op)
go Int
0 [Expr 'Byte]
l
  where
    go :: Int -> [Expr 'Byte] -> Seq (Int, Op)
go !Int
i ![Expr 'Byte]
xs =
      case forall s a. Cons s s a a => s -> Maybe (a, s)
uncons [Expr 'Byte]
xs of
        Maybe (Expr 'Byte, [Expr 'Byte])
Nothing ->
          forall a. Monoid a => a
mempty
        Just (Expr 'Byte
x, [Expr 'Byte]
xs') ->
          let x' :: Word8
x' = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"unexpected symbolic code argument") forall a b. (a -> b) -> a -> b
$ Expr 'Byte -> Maybe Word8
unlitByte Expr 'Byte
x
              j :: Int
j = Word8 -> Int
opSize Word8
x'
          in (Int
i, Word8 -> [Expr 'Byte] -> Op
readOp Word8
x' [Expr 'Byte]
xs') forall a. a -> Seq a -> Seq a
Seq.<| Int -> [Expr 'Byte] -> Seq (Int, Op)
go (Int
i forall a. Num a => a -> a -> a
+ Int
j) (forall a. Int -> [a] -> [a]
drop Int
j [Expr 'Byte]
xs)

-- * Gas cost calculation helpers

-- Gas cost function for CALL, transliterated from the Yellow Paper.
costOfCall
  :: FeeSchedule Word64
  -> Bool -> W256 -> Word64 -> Word64 -> Addr
  -> EVM (Word64, Word64)
costOfCall :: FeeSchedule Word64
-> Bool -> W256 -> Word64 -> Word64 -> Addr -> EVM (Word64, Word64)
costOfCall (FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
..}) Bool
recipientExists W256
xValue Word64
availableGas Word64
xGas Addr
target = do
  Bool
acc <- Addr -> EVM Bool
accessAccountForGas Addr
target
  let call_base_gas :: Word64
call_base_gas = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
      c_new :: Word64
c_new = if Bool -> Bool
not Bool
recipientExists Bool -> Bool -> Bool
&& W256
xValue forall a. Eq a => a -> a -> Bool
/= W256
0
            then Word64
g_newaccount
            else Word64
0
      c_xfer :: Word64
c_xfer = if W256
xValue forall a. Eq a => a -> a -> Bool
/= W256
0  then forall a b. (Integral a, Num b) => a -> b
num Word64
g_callvalue else Word64
0
      c_extra :: Word64
c_extra = Word64
call_base_gas forall a. Num a => a -> a -> a
+ Word64
c_xfer forall a. Num a => a -> a -> a
+ Word64
c_new
      c_gascap :: Word64
c_gascap =  if Word64
availableGas forall a. Ord a => a -> a -> Bool
>= Word64
c_extra
                  then forall a. Ord a => a -> a -> a
min Word64
xGas (forall a. (Num a, Integral a) => a -> a
allButOne64th (Word64
availableGas forall a. Num a => a -> a -> a
- Word64
c_extra))
                  else Word64
xGas
      c_callgas :: Word64
c_callgas = if W256
xValue forall a. Eq a => a -> a -> Bool
/= W256
0 then Word64
c_gascap forall a. Num a => a -> a -> a
+ Word64
g_callstipend else Word64
c_gascap
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
c_gascap forall a. Num a => a -> a -> a
+ Word64
c_extra, Word64
c_callgas)

-- Gas cost of create, including hash cost if needed
costOfCreate
  :: FeeSchedule Word64
  -> Word64 -> W256 -> (Word64, Word64)
costOfCreate :: FeeSchedule Word64 -> Word64 -> W256 -> (Word64, Word64)
costOfCreate (FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
..}) Word64
availableGas W256
hashSize =
  (Word64
createCost forall a. Num a => a -> a -> a
+ Word64
initGas, Word64
initGas)
  where
    createCost :: Word64
createCost = Word64
g_create forall a. Num a => a -> a -> a
+ Word64
hashCost
    hashCost :: Word64
hashCost   = Word64
g_sha3word forall a. Num a => a -> a -> a
* forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num W256
hashSize) Word64
32
    initGas :: Word64
initGas    = forall a. (Num a, Integral a) => a -> a
allButOne64th (Word64
availableGas forall a. Num a => a -> a -> a
- Word64
createCost)

concreteModexpGasFee :: ByteString -> Word64
concreteModexpGasFee :: ByteString -> Word64
concreteModexpGasFee ByteString
input =
  if W256
lenb forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
num (forall a. Bounded a => a
maxBound :: Word32) Bool -> Bool -> Bool
&&
     (W256
lene forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
num (forall a. Bounded a => a
maxBound :: Word32) Bool -> Bool -> Bool
|| (W256
lenb forall a. Eq a => a -> a -> Bool
== W256
0 Bool -> Bool -> Bool
&& W256
lenm forall a. Eq a => a -> a -> Bool
== W256
0)) Bool -> Bool -> Bool
&&
     W256
lenm forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
num (forall a. Bounded a => a
maxBound :: Word64)
  then
    forall a. Ord a => a -> a -> a
max Word64
200 ((Word64
multiplicationComplexity forall a. Num a => a -> a -> a
* Word64
iterCount) forall a. Integral a => a -> a -> a
`div` Word64
3)
  else
    forall a. Bounded a => a
maxBound -- TODO: this is not 100% correct, return Nothing on overflow
  where (W256
lenb, W256
lene, W256
lenm) = ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input
        ez :: Bool
ez = W256 -> W256 -> ByteString -> Bool
isZero (W256
96 forall a. Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input
        e' :: W256
e' = ByteString -> W256
word forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall a b. (a -> b) -> a -> b
$
          W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 forall a. Num a => a -> a -> a
+ W256
lenb) (forall a. Ord a => a -> a -> a
min W256
32 W256
lene) ByteString
input
        nwords :: Word64
        nwords :: Word64
nwords = forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max W256
lenb W256
lenm) Word64
8
        multiplicationComplexity :: Word64
multiplicationComplexity = Word64
nwords forall a. Num a => a -> a -> a
* Word64
nwords
        iterCount' :: Word64
        iterCount' :: Word64
iterCount' | W256
lene forall a. Ord a => a -> a -> Bool
<= W256
32 Bool -> Bool -> Bool
&& Bool
ez = Word64
0
                   | W256
lene forall a. Ord a => a -> a -> Bool
<= W256
32 = forall a b. (Integral a, Num b) => a -> b
num (forall b. FiniteBits b => b -> Int
log2 W256
e')
                   | W256
e' forall a. Eq a => a -> a -> Bool
== W256
0 = Word64
8 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
num W256
lene forall a. Num a => a -> a -> a
- Word64
32)
                   | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
num (forall b. FiniteBits b => b -> Int
log2 W256
e') forall a. Num a => a -> a -> a
+ Word64
8 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
num W256
lene forall a. Num a => a -> a -> a
- Word64
32)
        iterCount :: Word64
iterCount = forall a. Ord a => a -> a -> a
max Word64
iterCount' Word64
1

-- Gas cost of precompiles
costOfPrecompile :: FeeSchedule Word64 -> Addr -> Expr Buf -> Word64
costOfPrecompile :: FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile (FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
..}) Addr
precompileAddr Expr 'Buf
input =
  let errorDynamicSize :: a
errorDynamicSize = forall a. HasCallStack => String -> a
error String
"precompile input cannot have a dynamic size"
      inputLen :: Word64
inputLen = case Expr 'Buf
input of
                   ConcreteBuf ByteString
bs -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
                   AbstractBuf Text
_ -> forall {a}. a
errorDynamicSize
                   Expr 'Buf
buf -> case Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
buf of
                            Lit W256
l -> forall a b. (Integral a, Num b) => a -> b
num W256
l -- TODO: overflow
                            Expr 'EWord
_ -> forall {a}. a
errorDynamicSize
  in case Addr
precompileAddr of
    -- ECRECOVER
    Addr
0x1 -> Word64
3000
    -- SHA2-256
    Addr
0x2 -> forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ (((Word64
inputLen forall a. Num a => a -> a -> a
+ Word64
31) forall a. Integral a => a -> a -> a
`div` Word64
32) forall a. Num a => a -> a -> a
* Word64
12) forall a. Num a => a -> a -> a
+ Word64
60
    -- RIPEMD-160
    Addr
0x3 -> forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ (((Word64
inputLen forall a. Num a => a -> a -> a
+ Word64
31) forall a. Integral a => a -> a -> a
`div` Word64
32) forall a. Num a => a -> a -> a
* Word64
120) forall a. Num a => a -> a -> a
+ Word64
600
    -- IDENTITY
    Addr
0x4 -> forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ (((Word64
inputLen forall a. Num a => a -> a -> a
+ Word64
31) forall a. Integral a => a -> a -> a
`div` Word64
32) forall a. Num a => a -> a -> a
* Word64
3) forall a. Num a => a -> a -> a
+ Word64
15
    -- MODEXP
    Addr
0x5 -> case Expr 'Buf
input of
             ConcreteBuf ByteString
i -> ByteString -> Word64
concreteModexpGasFee ByteString
i
             Expr 'Buf
_ -> forall a. HasCallStack => String -> a
error String
"Unsupported symbolic modexp gas calc "
    -- ECADD
    Addr
0x6 -> Word64
g_ecadd
    -- ECMUL
    Addr
0x7 -> Word64
g_ecmul
    -- ECPAIRING
    Addr
0x8 -> (Word64
inputLen forall a. Integral a => a -> a -> a
`div` Word64
192) forall a. Num a => a -> a -> a
* Word64
g_pairing_point forall a. Num a => a -> a -> a
+ Word64
g_pairing_base
    -- BLAKE2
    Addr
0x9 -> case Expr 'Buf
input of
             ConcreteBuf ByteString
i -> Word64
g_fround forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
asInteger forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
0 W256
4 ByteString
i)
             Expr 'Buf
_ -> forall a. HasCallStack => String -> a
error String
"Unsupported symbolic blake2 gas calc"
    Addr
_ -> forall a. HasCallStack => String -> a
error (String
"unimplemented precompiled contract " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Addr
precompileAddr)

-- Gas cost of memory expansion
memoryCost :: FeeSchedule Word64 -> Word64 -> Word64
memoryCost :: FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule{Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
..} Word64
byteCount =
  let
    wordCount :: Word64
wordCount = forall a. (Num a, Integral a) => a -> a -> a
ceilDiv Word64
byteCount Word64
32
    linearCost :: Word64
linearCost = Word64
g_memory forall a. Num a => a -> a -> a
* Word64
wordCount
    quadraticCost :: Word64
quadraticCost = forall a. Integral a => a -> a -> a
div (Word64
wordCount forall a. Num a => a -> a -> a
* Word64
wordCount) Word64
512
  in
    Word64
linearCost forall a. Num a => a -> a -> a
+ Word64
quadraticCost

-- * Arithmetic

ceilDiv :: (Num a, Integral a) => a -> a -> a
ceilDiv :: forall a. (Num a, Integral a) => a -> a -> a
ceilDiv a
m a
n = forall a. Integral a => a -> a -> a
div (a
m forall a. Num a => a -> a -> a
+ a
n forall a. Num a => a -> a -> a
- a
1) a
n

allButOne64th :: (Num a, Integral a) => a -> a
allButOne64th :: forall a. (Num a, Integral a) => a -> a
allButOne64th a
n = a
n forall a. Num a => a -> a -> a
- forall a. Integral a => a -> a -> a
div a
n a
64

log2 :: FiniteBits b => b -> Int
log2 :: forall b. FiniteBits b => b -> Int
log2 b
x = forall b. FiniteBits b => b -> Int
finiteBitSize b
x forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- forall b. FiniteBits b => b -> Int
countLeadingZeros b
x

hashcode :: ContractCode -> Expr EWord
hashcode :: ContractCode -> Expr 'EWord
hashcode (InitCode ByteString
ops Expr 'Buf
args) = Expr 'Buf -> Expr 'EWord
keccak forall a b. (a -> b) -> a -> b
$ (ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops) forall a. Semigroup a => a -> a -> a
<> Expr 'Buf
args
hashcode (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = Expr 'Buf -> Expr 'EWord
keccak (ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops)
hashcode (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Expr 'Buf -> Expr 'EWord
keccak forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops

-- | The length of the code ignoring any constructor args.
-- This represents the region that can contain executable opcodes
opslen :: ContractCode -> Int
opslen :: ContractCode -> Int
opslen (InitCode ByteString
ops Expr 'Buf
_) = ByteString -> Int
BS.length ByteString
ops
opslen (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = ByteString -> Int
BS.length ByteString
ops
opslen (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops

-- | The length of the code including any constructor args.
-- This can return an abstract value
codelen :: ContractCode -> Expr EWord
codelen :: ContractCode -> Expr 'EWord
codelen c :: ContractCode
c@(InitCode {}) = Expr 'Buf -> Expr 'EWord
bufLength forall a b. (a -> b) -> a -> b
$ ContractCode -> Expr 'Buf
toBuf ContractCode
c
codelen (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = W256 -> Expr 'EWord
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
ops
codelen (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = W256 -> Expr 'EWord
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops

toBuf :: ContractCode -> Expr Buf
toBuf :: ContractCode -> Expr 'Buf
toBuf (InitCode ByteString
ops Expr 'Buf
args) = ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops forall a. Semigroup a => a -> a -> a
<> Expr 'Buf
args
toBuf (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops
toBuf (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList Vector (Expr 'Byte)
ops


codeloc :: EVM CodeLocation
codeloc :: EVM CodeLocation
codeloc = do
  VM
vm <- forall s (m :: * -> *). MonadState s m => m s
get
  let self :: Addr
self = VM
vm._state._contract
      loc :: Int
loc = VM
vm._state._pc
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr
self, Int
loc)

-- * Emacs setup

-- Local Variables:
-- outline-regexp: "-- \\*+\\|data \\|newtype \\|type \\| +-- op: "
-- outline-heading-alist:
--   (("-- *" . 1) ("data " . 2) ("newtype " . 2) ("type " . 2))
-- compile-command: "make"
-- End: