{-# Language ImplicitParams #-}
{-# Language ConstraintKinds #-}
{-# Language FlexibleInstances #-}
{-# Language DataKinds #-}
{-# Language GADTs #-}
{-# Language RecordWildCards #-}
{-# Language ScopedTypeVariables #-}
{-# Language StandaloneDeriving #-}
{-# Language StrictData #-}
{-# Language TemplateHaskell #-}
{-# Language TypeOperators #-}
{-# Language ViewPatterns #-}

module EVM where

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

import Data.SBV hiding (Word, output, Unknown)
import Data.Proxy (Proxy(..))
import Data.Text (unpack)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Vector as V
import EVM.ABI
import EVM.Types
import EVM.Solidity
import EVM.Concrete (createAddress, wordValue, keccakBlob, create2Address, readMemoryWord)
import EVM.Symbolic
import EVM.Op
import EVM.FeeSchedule (FeeSchedule (..))
import Options.Generic as Options
import qualified EVM.Precompiled

import Control.Lens hiding (op, (:<), (|>), (.>))
import Control.Monad.State.Strict hiding (state)

import Data.ByteString              (ByteString)
import Data.ByteString.Lazy         (fromStrict)
import Data.Map.Strict              (Map)
import Data.Set                     (Set, insert, member, fromList)
import Data.Maybe                   (fromMaybe)
import Data.Sequence                (Seq)
import Data.Vector.Storable         (Vector)
import Data.Foldable                (toList)

import Data.Tree
import Data.List (find)

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LS
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteArray       as BA
import qualified Data.Map.Strict      as Map
import qualified Data.Sequence        as Seq
import qualified Data.Tree.Zipper     as Zipper
import qualified Data.Vector          as V
import qualified Data.Vector.Storable as Vector
import qualified Data.Vector.Storable.Mutable as Vector

import qualified Data.Vector as RegularVector

import Crypto.Number.ModArithmetic (expFast)
import qualified Crypto.Hash as Crypto
import Crypto.Hash (Digest, SHA256, RIPEMD160, digestFromByteString)
import Crypto.PubKey.ECC.ECDSA (signDigestWith, PrivateKey(..), Signature(..))
import Crypto.PubKey.ECC.Types (getCurveByName, CurveName(..), Point(..))
import Crypto.PubKey.ECC.Generate (generateQ)

-- * Data types

-- | EVM failure modes
data Error
  = BalanceTooLow Word Word
  | UnrecognizedOpcode Word8
  | SelfDestruction
  | StackUnderrun
  | BadJumpDestination
  | Revert ByteString
  | NoSuchContract Addr
  | OutOfGas Word Word
  | BadCheatCode (Maybe Word32)
  | StackLimitExceeded
  | IllegalOverflow
  | Query Query
  | Choose Choose
  | StateChangeWhileStatic
  | InvalidMemoryAccess
  | CallDepthLimitReached
  | MaxCodeSizeExceeded Word Word
  | PrecompileFailure
  | UnexpectedSymbolicArg
  | DeadPath
  | NotUnique Whiff
  | SMTTimeout
  | FFI AbiVals
deriving instance Show Error

-- | The possible result states of a VM
data VMResult
  = VMFailure Error -- ^ An operation failed
  | VMSuccess Buffer -- ^ 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 -> Seq Log
_logs           :: Seq Log
  , VM -> TreePos Empty Trace
_traces         :: Zipper.TreePos Zipper.Empty Trace
  , VM -> Cache
_cache          :: Cache
  , VM -> Word
_burned         :: Word
  , VM -> [(SBool, Whiff)]
_constraints    :: [(SBool, Whiff)]
  , VM -> Map CodeLocation Int
_iterations     :: Map CodeLocation Int
  , VM -> Bool
_allowFFI       :: Bool
  }
  deriving (Int -> VM -> ShowS
[VM] -> ShowS
VM -> String
(Int -> VM -> ShowS)
-> (VM -> String) -> ([VM] -> ShowS) -> Show VM
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
(Int -> Trace -> ShowS)
-> (Trace -> String) -> ([Trace] -> ShowS) -> Show Trace
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 Log
  | FrameTrace FrameContext
  | QueryTrace Query
  | ErrorTrace Error
  | EntryTrace Text
  | ReturnTrace Buffer FrameContext
  deriving (Int -> TraceData -> ShowS
[TraceData] -> ShowS
TraceData -> String
(Int -> TraceData -> ShowS)
-> (TraceData -> String)
-> ([TraceData] -> ShowS)
-> Show TraceData
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 -> StorageModel -> (Contract -> EVM ()) -> Query
  PleaseMakeUnique    :: SymVal a => SBV a -> [SBool] -> (IsUnique a -> EVM ()) -> Query
  PleaseFetchSlot     :: Addr -> Word -> (Word -> EVM ()) -> Query
  PleaseAskSMT        :: SBool -> [SBool] -> (BranchCondition -> EVM ()) -> Query
  PleaseDoFFI         :: [String] -> (ByteString -> EVM ()) -> Query

data Choose where
  PleaseChoosePath    :: Whiff -> (Bool -> EVM ()) -> Choose

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

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

-- | 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
(Int -> BranchCondition -> ShowS)
-> (BranchCondition -> String)
-> ([BranchCondition] -> ShowS)
-> Show BranchCondition
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
[IsUnique a] -> ShowS
IsUnique a -> String
(Int -> IsUnique a -> ShowS)
-> (IsUnique a -> String)
-> ([IsUnique a] -> ShowS)
-> Show (IsUnique a)
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
_fetched :: Map Addr Contract,
    Cache -> Map (CodeLocation, Int) Bool
_path :: Map (CodeLocation, Int) Bool
  } deriving Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
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

-- | A way to specify an initial VM state
data VMOpts = VMOpts
  { VMOpts -> Contract
vmoptContract :: Contract
  , VMOpts -> (Buffer, SymWord)
vmoptCalldata :: (Buffer, SymWord)
  , VMOpts -> SymWord
vmoptValue :: SymWord
  , VMOpts -> Addr
vmoptAddress :: Addr
  , VMOpts -> SAddr
vmoptCaller :: SAddr
  , VMOpts -> Addr
vmoptOrigin :: Addr
  , VMOpts -> W256
vmoptGas :: W256
  , VMOpts -> W256
vmoptGaslimit :: W256
  , VMOpts -> W256
vmoptNumber :: W256
  , VMOpts -> SymWord
vmoptTimestamp :: SymWord
  , VMOpts -> Addr
vmoptCoinbase :: Addr
  , VMOpts -> W256
vmoptDifficulty :: W256
  , VMOpts -> W256
vmoptMaxCodeSize :: W256
  , VMOpts -> W256
vmoptBlockGaslimit :: W256
  , VMOpts -> W256
vmoptGasprice :: W256
  , VMOpts -> FeeSchedule Integer
vmoptSchedule :: FeeSchedule Integer
  , VMOpts -> W256
vmoptChainId :: W256
  , VMOpts -> Bool
vmoptCreate :: Bool
  , VMOpts -> StorageModel
vmoptStorageModel :: StorageModel
  , VMOpts -> Map Addr [W256]
vmoptTxAccessList :: Map Addr [W256]
  , VMOpts -> Bool
vmoptAllowFFI :: Bool
  } deriving Int -> VMOpts -> ShowS
[VMOpts] -> ShowS
VMOpts -> String
(Int -> VMOpts -> ShowS)
-> (VMOpts -> String) -> ([VMOpts] -> ShowS) -> Show VMOpts
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

-- | A log entry
data Log = Log Addr Buffer [SymWord]
  deriving (Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> 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
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
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 -> W256
creationContextCodehash  :: W256
    , FrameContext -> Map Addr Contract
creationContextReversion :: Map Addr Contract
    , FrameContext -> SubState
creationContextSubstate  :: SubState
    }
  | CallContext
    { FrameContext -> Addr
callContextTarget    :: Addr
    , FrameContext -> Addr
callContextContext   :: Addr
    , FrameContext -> Word
callContextOffset    :: Word
    , FrameContext -> Word
callContextSize      :: Word
    , FrameContext -> W256
callContextCodehash  :: W256
    , FrameContext -> Maybe Word
callContextAbi       :: Maybe Word
    , FrameContext -> Buffer
callContextData      :: Buffer
    , FrameContext -> Map Addr Contract
callContextReversion :: Map Addr Contract
    , FrameContext -> SubState
callContextSubState  :: SubState
    }
  deriving (Int -> FrameContext -> ShowS
[FrameContext] -> ShowS
FrameContext -> String
(Int -> FrameContext -> ShowS)
-> (FrameContext -> String)
-> ([FrameContext] -> ShowS)
-> Show FrameContext
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 -> Buffer
_code         :: Buffer
  , FrameState -> Int
_pc           :: Int
  , FrameState -> [SymWord]
_stack        :: [SymWord]
  , FrameState -> Buffer
_memory       :: Buffer
  , FrameState -> Int
_memorySize   :: Int
  , FrameState -> (Buffer, SymWord)
_calldata     :: (Buffer, SymWord)
  , FrameState -> SymWord
_callvalue    :: SymWord
  , FrameState -> SAddr
_caller       :: SAddr
  , FrameState -> Word
_gas          :: Word
  , FrameState -> Buffer
_returndata   :: Buffer
  , FrameState -> Bool
_static       :: Bool
  }
  deriving (Int -> FrameState -> ShowS
[FrameState] -> ShowS
FrameState -> String
(Int -> FrameState -> ShowS)
-> (FrameState -> String)
-> ([FrameState] -> ShowS)
-> Show FrameState
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 -> Word
_gasprice            :: Word
  , TxState -> Word
_txgaslimit          :: Word
  , TxState -> Addr
_origin              :: Addr
  , TxState -> Addr
_toAddr              :: Addr
  , TxState -> SymWord
_value               :: SymWord
  , TxState -> SubState
_substate            :: SubState
  , TxState -> Bool
_isCreate            :: Bool
  , TxState -> Map Addr Contract
_txReversion         :: Map Addr Contract
  }
  deriving (Int -> TxState -> ShowS
[TxState] -> ShowS
TxState -> String
(Int -> TxState -> ShowS)
-> (TxState -> String) -> ([TxState] -> ShowS) -> Show TxState
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, Integer)]
_refunds         :: [(Addr, Integer)]
  -- in principle we should include logs here, but do not for now
  }
  deriving (Int -> SubState -> ShowS
[SubState] -> ShowS
SubState -> String
(Int -> SubState -> ShowS)
-> (SubState -> String) -> ([SubState] -> ShowS) -> Show SubState
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.
data ContractCode
  = InitCode Buffer     -- ^ "Constructor" code, during contract creation
  | RuntimeCode Buffer  -- ^ "Instance" code, after contract creation
  deriving (Int -> ContractCode -> ShowS
[ContractCode] -> ShowS
ContractCode -> String
(Int -> ContractCode -> ShowS)
-> (ContractCode -> String)
-> ([ContractCode] -> ShowS)
-> Show ContractCode
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)

-- runtime err when used for symbolic code
instance Eq ContractCode where
  (InitCode Buffer
x) == :: ContractCode -> ContractCode -> Bool
== (InitCode Buffer
y) = Buffer -> ByteString
forceBuffer Buffer
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer -> ByteString
forceBuffer Buffer
y
  (RuntimeCode Buffer
x) == (RuntimeCode Buffer
y) = Buffer -> ByteString
forceBuffer Buffer
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer -> ByteString
forceBuffer Buffer
y
  ContractCode
_ == ContractCode
_ = Bool
False

-- runtime err when used for symbolic code
instance Ord ContractCode where
  compare :: ContractCode -> ContractCode -> Ordering
compare ContractCode
x ContractCode
y = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Buffer -> ByteString
forceBuffer (ContractCode -> Buffer
buf ContractCode
x)) (Buffer -> ByteString
forceBuffer (ContractCode -> Buffer
buf ContractCode
y))
    where buf :: ContractCode -> Buffer
buf (InitCode Buffer
z) = Buffer
z
          buf (RuntimeCode Buffer
z) = Buffer
z

-- | A contract can either have concrete or symbolic storage
-- depending on what type of execution we are doing
data Storage
  = Concrete (Map Word SymWord)
  | Symbolic [(SymWord, SymWord)] (SArray (WordN 256) (WordN 256))
  deriving (Int -> Storage -> ShowS
[Storage] -> ShowS
Storage -> String
(Int -> Storage -> ShowS)
-> (Storage -> String) -> ([Storage] -> ShowS) -> Show Storage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Storage] -> ShowS
$cshowList :: [Storage] -> ShowS
show :: Storage -> String
$cshow :: Storage -> String
showsPrec :: Int -> Storage -> ShowS
$cshowsPrec :: Int -> Storage -> ShowS
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
  == :: Storage -> Storage -> Bool
(==) (Concrete Map Word SymWord
a) (Concrete Map Word SymWord
b) = (SymWord -> Word) -> Map Word SymWord -> Map Word Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymWord -> Word
forceLit Map Word SymWord
a Map Word Word -> Map Word Word -> Bool
forall a. Eq a => a -> a -> Bool
== (SymWord -> Word) -> Map Word SymWord -> Map Word Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymWord -> Word
forceLit Map Word SymWord
b
  (==) (Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
_) (Concrete Map Word SymWord
_) = Bool
False
  (==) (Concrete Map Word SymWord
_) (Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
_) = Bool
False
  (==) Storage
_ Storage
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"do not compare two symbolic arrays like this!"

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

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]
(Int -> ReadS StorageModel)
-> ReadS [StorageModel]
-> ReadPrec StorageModel
-> ReadPrec [StorageModel]
-> Read 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
(Int -> StorageModel -> ShowS)
-> (StorageModel -> String)
-> ([StorageModel] -> ShowS)
-> Show StorageModel
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 -> Word
_chainId      :: Word
  , Env -> StorageModel
_storageModel :: StorageModel
  , Env -> Map Word ByteString
_sha3Crack    :: Map Word ByteString
  , Env -> [([SWord 8], SWord 256)]
_keccakUsed   :: [([SWord 8], SWord 256)]
  }
  deriving (Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
(Int -> Env -> ShowS)
-> (Env -> String) -> ([Env] -> ShowS) -> Show Env
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 -> SymWord
_timestamp   :: SymWord
  , Block -> Word
_number      :: Word
  , Block -> Word
_difficulty  :: Word
  , Block -> Word
_gaslimit    :: Word
  , Block -> Word
_maxCodeSize :: Word
  , Block -> FeeSchedule Integer
_schedule    :: FeeSchedule Integer
  } deriving Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
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

blankState :: FrameState
blankState :: FrameState
blankState = FrameState :: Addr
-> Addr
-> Buffer
-> Int
-> [SymWord]
-> Buffer
-> Int
-> (Buffer, SymWord)
-> SymWord
-> SAddr
-> Word
-> Buffer
-> Bool
-> FrameState
FrameState
  { _contract :: Addr
_contract     = Addr
0
  , _codeContract :: Addr
_codeContract = Addr
0
  , _code :: Buffer
_code         = Buffer
forall a. Monoid a => a
mempty
  , _pc :: Int
_pc           = Int
0
  , _stack :: [SymWord]
_stack        = [SymWord]
forall a. Monoid a => a
mempty
  , _memory :: Buffer
_memory       = Buffer
forall a. Monoid a => a
mempty
  , _memorySize :: Int
_memorySize   = Int
0
  , _calldata :: (Buffer, SymWord)
_calldata     = (Buffer
forall a. Monoid a => a
mempty, SymWord
0)
  , _callvalue :: SymWord
_callvalue    = SymWord
0
  , _caller :: SAddr
_caller       = SAddr
0
  , _gas :: Word
_gas          = Word
0
  , _returndata :: Buffer
_returndata   = Buffer
forall a. Monoid a => a
mempty
  , _static :: 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 Buffer
bytecode :: (Buffer -> f Buffer) -> Contract -> f Contract
bytecode = (ContractCode -> f ContractCode) -> Contract -> f Contract
Lens' Contract ContractCode
contractcode ((ContractCode -> f ContractCode) -> Contract -> f Contract)
-> ((Buffer -> f Buffer) -> ContractCode -> f ContractCode)
-> (Buffer -> f Buffer)
-> Contract
-> f Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractCode -> Buffer)
-> (Buffer -> f Buffer) -> ContractCode -> f ContractCode
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ContractCode -> Buffer
f
  where f :: ContractCode -> Buffer
f (InitCode Buffer
_)    = Buffer
forall a. Monoid a => a
mempty
        f (RuntimeCode Buffer
b) = Buffer
b

instance Semigroup Cache where
  Cache
a <> :: Cache -> Cache -> Cache
<> Cache
b = Cache :: Map Addr Contract -> Map (CodeLocation, Int) Bool -> Cache
Cache
    { _fetched :: Map Addr Contract
_fetched = (Contract -> Contract -> Contract)
-> Map Addr Contract -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Contract -> Contract -> Contract
unifyCachedContract (Getting (Map Addr Contract) Cache (Map Addr Contract)
-> Cache -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Addr Contract) Cache (Map Addr Contract)
Lens' Cache (Map Addr Contract)
fetched Cache
a) (Getting (Map Addr Contract) Cache (Map Addr Contract)
-> Cache -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Addr Contract) Cache (Map Addr Contract)
Lens' Cache (Map Addr Contract)
fetched Cache
b)
    , _path :: Map (CodeLocation, Int) Bool
_path = Map (CodeLocation, Int) Bool
-> Map (CodeLocation, Int) Bool -> Map (CodeLocation, Int) Bool
forall a. Monoid a => a -> a -> a
mappend (Getting
  (Map (CodeLocation, Int) Bool) Cache (Map (CodeLocation, Int) Bool)
-> Cache -> Map (CodeLocation, Int) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map (CodeLocation, Int) Bool) Cache (Map (CodeLocation, Int) Bool)
Lens' Cache (Map (CodeLocation, Int) Bool)
path Cache
a) (Getting
  (Map (CodeLocation, Int) Bool) Cache (Map (CodeLocation, Int) Bool)
-> Cache -> Map (CodeLocation, Int) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map (CodeLocation, Int) Bool) Cache (Map (CodeLocation, Int) Bool)
Lens' Cache (Map (CodeLocation, Int) Bool)
path Cache
b)
    }

-- only intended for use in Cache merges, where we expect
-- everything to be Concrete
unifyCachedContract :: Contract -> Contract -> Contract
unifyCachedContract :: Contract -> Contract -> Contract
unifyCachedContract Contract
a Contract
b = Contract
a Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage Storage
merged
  where merged :: Storage
merged = case (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
a, Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
b) of
                   (Concrete Map Word SymWord
sa, Concrete Map Word SymWord
sb) ->
                     Map Word SymWord -> Storage
Concrete (Map Word SymWord -> Map Word SymWord -> Map Word SymWord
forall a. Monoid a => a -> a -> a
mappend Map Word SymWord
sa Map Word SymWord
sb)
                   (Storage, Storage)
_ ->
                     Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
a

instance Monoid Cache where
  mempty :: Cache
mempty = Cache :: Map Addr Contract -> Map (CodeLocation, Int) Bool -> Cache
Cache { _fetched :: Map Addr Contract
_fetched = Map Addr Contract
forall a. Monoid a => a
mempty,
                   _path :: Map (CodeLocation, Int) Bool
_path = Map (CodeLocation, Int) Bool
forall a. Monoid a => a
mempty
                 }

-- * Data accessors

currentContract :: VM -> Maybe Contract
currentContract :: VM -> Maybe Contract
currentContract VM
vm =
  Getting (Maybe Contract) VM (Maybe Contract)
-> VM -> Maybe Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
codeContract) VM
vm)) VM
vm

-- * Data constructors

makeVm :: VMOpts -> VM
makeVm :: VMOpts -> VM
makeVm VMOpts
o =
  let txaccessList :: Map Addr [W256]
txaccessList = VMOpts -> Map Addr [W256]
vmoptTxAccessList VMOpts
o
      txorigin :: Addr
txorigin = VMOpts -> Addr
vmoptOrigin VMOpts
o
      txtoAddr :: Addr
txtoAddr = VMOpts -> Addr
vmoptAddress VMOpts
o
      initialAccessedAddrs :: Set Addr
initialAccessedAddrs = [Addr] -> Set Addr
forall a. Ord a => [a] -> Set a
fromList ([Addr] -> Set Addr) -> [Addr] -> Set Addr
forall a b. (a -> b) -> a -> b
$ [Addr
txorigin, Addr
txtoAddr] [Addr] -> [Addr] -> [Addr]
forall a. [a] -> [a] -> [a]
++ [Addr
1..Addr
9] [Addr] -> [Addr] -> [Addr]
forall a. [a] -> [a] -> [a]
++ (Map Addr [W256] -> [Addr]
forall k a. Map k a -> [k]
Map.keys Map Addr [W256]
txaccessList)
      initialAccessedStorageKeys :: Set (Addr, W256)
initialAccessedStorageKeys = [(Addr, W256)] -> Set (Addr, W256)
forall a. Ord a => [a] -> Set a
fromList ([(Addr, W256)] -> Set (Addr, W256))
-> [(Addr, W256)] -> Set (Addr, W256)
forall a b. (a -> b) -> a -> b
$ ((Addr, [W256]) -> [(Addr, W256)])
-> [(Addr, [W256])] -> [(Addr, W256)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Addr -> [W256] -> [(Addr, W256)])
-> (Addr, [W256]) -> [(Addr, W256)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((W256 -> (Addr, W256)) -> [W256] -> [(Addr, W256)]
forall a b. (a -> b) -> [a] -> [b]
map ((W256 -> (Addr, W256)) -> [W256] -> [(Addr, W256)])
-> (Addr -> W256 -> (Addr, W256))
-> Addr
-> [W256]
-> [(Addr, W256)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))) (Map Addr [W256] -> [(Addr, [W256])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Addr [W256]
txaccessList)
      touched :: [Addr]
touched = if VMOpts -> Bool
vmoptCreate VMOpts
o then [Addr
txorigin] else [Addr
txorigin, Addr
txtoAddr]
  in
  VM :: Maybe VMResult
-> FrameState
-> [Frame]
-> Env
-> Block
-> TxState
-> Seq Log
-> TreePos Empty Trace
-> Cache
-> Word
-> [(SBool, Whiff)]
-> Map CodeLocation Int
-> Bool
-> VM
VM
  { _result :: Maybe VMResult
_result = Maybe VMResult
forall a. Maybe a
Nothing
  , _frames :: [Frame]
_frames = [Frame]
forall a. Monoid a => a
mempty
  , _tx :: TxState
_tx = TxState :: Word
-> Word
-> Addr
-> Addr
-> SymWord
-> SubState
-> Bool
-> Map Addr Contract
-> TxState
TxState
    { _gasprice :: Word
_gasprice = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptGasprice VMOpts
o
    , _txgaslimit :: Word
_txgaslimit = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptGaslimit VMOpts
o
    , _origin :: Addr
_origin = Addr
txorigin
    , _toAddr :: Addr
_toAddr = Addr
txtoAddr
    , _value :: SymWord
_value = VMOpts -> SymWord
vmoptValue VMOpts
o
    , _substate :: SubState
_substate = [Addr]
-> [Addr]
-> Set Addr
-> Set (Addr, W256)
-> [(Addr, Integer)]
-> SubState
SubState [Addr]
forall a. Monoid a => a
mempty [Addr]
touched Set Addr
initialAccessedAddrs Set (Addr, W256)
initialAccessedStorageKeys [(Addr, Integer)]
forall a. Monoid a => a
mempty
    --, _accessList = txaccessList
    , _isCreate :: Bool
_isCreate = VMOpts -> Bool
vmoptCreate VMOpts
o
    , _txReversion :: Map Addr Contract
_txReversion = [(Addr, Contract)] -> Map Addr Contract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(VMOpts -> Addr
vmoptAddress VMOpts
o, VMOpts -> Contract
vmoptContract VMOpts
o)]
    }
  , _logs :: Seq Log
_logs = Seq Log
forall a. Monoid a => a
mempty
  , _traces :: TreePos Empty Trace
_traces = Forest Trace -> TreePos Empty Trace
forall a. Forest a -> TreePos Empty a
Zipper.fromForest []
  , _block :: Block
_block = Block :: Addr
-> SymWord
-> Word
-> Word
-> Word
-> Word
-> FeeSchedule Integer
-> Block
Block
    { _coinbase :: Addr
_coinbase = VMOpts -> Addr
vmoptCoinbase VMOpts
o
    , _timestamp :: SymWord
_timestamp = VMOpts -> SymWord
vmoptTimestamp VMOpts
o
    , _number :: Word
_number = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptNumber VMOpts
o
    , _difficulty :: Word
_difficulty = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptDifficulty VMOpts
o
    , _maxCodeSize :: Word
_maxCodeSize = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptMaxCodeSize VMOpts
o
    , _gaslimit :: Word
_gaslimit = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptBlockGaslimit VMOpts
o
    , _schedule :: FeeSchedule Integer
_schedule = VMOpts -> FeeSchedule Integer
vmoptSchedule VMOpts
o
    }
  , _state :: FrameState
_state = FrameState :: Addr
-> Addr
-> Buffer
-> Int
-> [SymWord]
-> Buffer
-> Int
-> (Buffer, SymWord)
-> SymWord
-> SAddr
-> Word
-> Buffer
-> Bool
-> FrameState
FrameState
    { _pc :: Int
_pc = Int
0
    , _stack :: [SymWord]
_stack = [SymWord]
forall a. Monoid a => a
mempty
    , _memory :: Buffer
_memory = Buffer
forall a. Monoid a => a
mempty
    , _memorySize :: Int
_memorySize = Int
0
    , _code :: Buffer
_code = Buffer
theCode
    , _contract :: Addr
_contract = VMOpts -> Addr
vmoptAddress VMOpts
o
    , _codeContract :: Addr
_codeContract = VMOpts -> Addr
vmoptAddress VMOpts
o
    , _calldata :: (Buffer, SymWord)
_calldata = VMOpts -> (Buffer, SymWord)
vmoptCalldata VMOpts
o
    , _callvalue :: SymWord
_callvalue = VMOpts -> SymWord
vmoptValue VMOpts
o
    , _caller :: SAddr
_caller = VMOpts -> SAddr
vmoptCaller VMOpts
o
    , _gas :: Word
_gas = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptGas VMOpts
o
    , _returndata :: Buffer
_returndata = Buffer
forall a. Monoid a => a
mempty
    , _static :: Bool
_static = Bool
False
    }
  , _env :: Env
_env = Env :: Map Addr Contract
-> Word
-> StorageModel
-> Map Word ByteString
-> [([SWord 8], SWord 256)]
-> Env
Env
    { _sha3Crack :: Map Word ByteString
_sha3Crack = Map Word ByteString
forall a. Monoid a => a
mempty
    , _chainId :: Word
_chainId = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ VMOpts -> W256
vmoptChainId VMOpts
o
    , _contracts :: Map Addr Contract
_contracts = [(Addr, Contract)] -> Map Addr Contract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(VMOpts -> Addr
vmoptAddress VMOpts
o, VMOpts -> Contract
vmoptContract VMOpts
o)]
    , _keccakUsed :: [([SWord 8], SWord 256)]
_keccakUsed = [([SWord 8], SWord 256)]
forall a. Monoid a => a
mempty
    , _storageModel :: StorageModel
_storageModel = VMOpts -> StorageModel
vmoptStorageModel VMOpts
o
    }
  , _cache :: Cache
_cache = Map Addr Contract -> Map (CodeLocation, Int) Bool -> Cache
Cache Map Addr Contract
forall a. Monoid a => a
mempty Map (CodeLocation, Int) Bool
forall a. Monoid a => a
mempty
  , _burned :: Word
_burned = Word
0
  , _constraints :: [(SBool, Whiff)]
_constraints = []
  , _iterations :: Map CodeLocation Int
_iterations = Map CodeLocation Int
forall a. Monoid a => a
mempty
  , _allowFFI :: Bool
_allowFFI = VMOpts -> Bool
vmoptAllowFFI VMOpts
o
  } where theCode :: Buffer
theCode = case Contract -> ContractCode
_contractcode (VMOpts -> Contract
vmoptContract VMOpts
o) of
            InitCode Buffer
b    -> Buffer
b
            RuntimeCode Buffer
b -> Buffer
b

-- | Initialize empty contract with given code
initialContract :: ContractCode -> Contract
initialContract :: ContractCode -> Contract
initialContract ContractCode
theContractCode = Contract :: ContractCode
-> Storage
-> Word
-> Word
-> W256
-> Vector Int
-> Vector (Int, Op)
-> Bool
-> Map Word Word
-> Contract
Contract
  { _contractcode :: ContractCode
_contractcode = ContractCode
theContractCode
  , _codehash :: W256
_codehash =
    case Buffer
theCode of
      ConcreteBuffer ByteString
b -> ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
b)
      SymbolicBuffer [SWord 8]
_ -> W256
0

  , _storage :: Storage
_storage  = Map Word SymWord -> Storage
Concrete Map Word SymWord
forall a. Monoid a => a
mempty
  , _balance :: Word
_balance  = Word
0
  , _nonce :: Word
_nonce    = if Bool
creation then Word
1 else Word
0
  , _opIxMap :: Vector Int
_opIxMap  = Buffer -> Vector Int
mkOpIxMap Buffer
theCode
  , _codeOps :: Vector (Int, Op)
_codeOps  = Buffer -> Vector (Int, Op)
mkCodeOps Buffer
theCode
  , _external :: Bool
_external = Bool
False
  , _origStorage :: Map Word Word
_origStorage = Map Word Word
forall a. Monoid a => a
mempty
  } where
      (Bool
creation, Buffer
theCode) = case ContractCode
theContractCode of
            InitCode Buffer
b    -> (Bool
True, Buffer
b)
            RuntimeCode Buffer
b -> (Bool
False, Buffer
b)

contractWithStore :: ContractCode -> Storage -> Contract
contractWithStore :: ContractCode -> Storage -> Contract
contractWithStore ContractCode
theContractCode Storage
store =
  ContractCode -> Contract
initialContract ContractCode
theContractCode Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage Storage
store

-- * Opcode dispatch (exec1)

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

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

  let
    -- Convenience function to access parts of the current VM state.
    -- Arcane type signature needed to avoid monomorphism restriction.
    the :: (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
    the :: (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the b -> VM -> Const a VM
f (a -> Const a a) -> b
g = Getting a VM a -> VM -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (b -> VM -> Const a VM
f (b -> VM -> Const a VM)
-> ((a -> Const a a) -> b) -> Getting a VM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> b
g) VM
vm

    -- Convenient aliases
    mem :: Buffer
mem  = ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory
    stk :: [SymWord]
stk  = ((FrameState -> Const [SymWord] FrameState)
 -> VM -> Const [SymWord] VM)
-> (([SymWord] -> Const [SymWord] [SymWord])
    -> FrameState -> Const [SymWord] FrameState)
-> [SymWord]
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const [SymWord] FrameState)
-> VM -> Const [SymWord] VM
Lens' VM FrameState
state ([SymWord] -> Const [SymWord] [SymWord])
-> FrameState -> Const [SymWord] FrameState
Lens' FrameState [SymWord]
stack
    self :: Addr
self = ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Addr
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract
    this :: Contract
this = Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe (String -> Contract
forall a. HasCallStack => String -> a
error String
"internal error: state contract") (Getting (First Contract) (Map Addr Contract) Contract
-> Map Addr Contract -> Maybe Contract
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
self) (((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Map Addr Contract
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts))

    fees :: FeeSchedule Integer
fees@FeeSchedule {Integer
g_access_list_storage_key :: forall n. FeeSchedule n -> n
g_access_list_address :: forall n. FeeSchedule n -> n
g_warm_storage_read :: forall n. FeeSchedule n -> n
g_cold_account_access :: forall n. FeeSchedule n -> n
g_cold_sload :: forall n. FeeSchedule n -> n
r_block :: forall n. FeeSchedule n -> n
g_fround :: forall n. FeeSchedule n -> n
g_pairing_base :: forall n. FeeSchedule n -> n
g_pairing_point :: forall n. FeeSchedule n -> n
g_ecmul :: forall n. FeeSchedule n -> n
g_ecadd :: forall n. FeeSchedule n -> n
g_quaddivisor :: forall n. FeeSchedule n -> n
g_extcodehash :: forall n. FeeSchedule n -> n
g_blockhash :: forall n. FeeSchedule n -> n
g_copy :: forall n. FeeSchedule n -> n
g_sha3word :: forall n. FeeSchedule n -> n
g_sha3 :: forall n. FeeSchedule n -> n
g_logtopic :: forall n. FeeSchedule n -> n
g_logdata :: forall n. FeeSchedule n -> n
g_log :: forall n. FeeSchedule n -> n
g_transaction :: forall n. FeeSchedule n -> n
g_txdatanonzero :: forall n. FeeSchedule n -> n
g_txdatazero :: forall n. FeeSchedule n -> n
g_txcreate :: forall n. FeeSchedule n -> n
g_memory :: forall n. FeeSchedule n -> n
g_expbyte :: forall n. FeeSchedule n -> n
g_exp :: forall n. FeeSchedule n -> n
g_newaccount :: forall n. FeeSchedule n -> n
g_callstipend :: forall n. FeeSchedule n -> n
g_callvalue :: forall n. FeeSchedule n -> n
g_call :: forall n. FeeSchedule n -> n
g_codedeposit :: forall n. FeeSchedule n -> n
g_create :: forall n. FeeSchedule n -> n
r_selfdestruct :: forall n. FeeSchedule n -> n
g_selfdestruct_newaccount :: forall n. FeeSchedule n -> n
g_selfdestruct :: forall n. FeeSchedule n -> n
r_sclear :: forall n. FeeSchedule n -> n
g_sreset :: forall n. FeeSchedule n -> n
g_sset :: forall n. FeeSchedule n -> n
g_jumpdest :: forall n. FeeSchedule n -> n
g_sload :: forall n. FeeSchedule n -> n
g_balance :: forall n. FeeSchedule n -> n
g_extcode :: forall n. FeeSchedule n -> n
g_high :: forall n. FeeSchedule n -> n
g_mid :: forall n. FeeSchedule n -> n
g_low :: forall n. FeeSchedule n -> n
g_verylow :: forall n. FeeSchedule n -> n
g_base :: forall n. FeeSchedule n -> n
g_zero :: forall n. FeeSchedule n -> n
g_access_list_storage_key :: Integer
g_access_list_address :: Integer
g_warm_storage_read :: Integer
g_cold_account_access :: Integer
g_cold_sload :: Integer
r_block :: Integer
g_fround :: Integer
g_pairing_base :: Integer
g_pairing_point :: Integer
g_ecmul :: Integer
g_ecadd :: Integer
g_quaddivisor :: Integer
g_extcodehash :: Integer
g_blockhash :: Integer
g_copy :: Integer
g_sha3word :: Integer
g_sha3 :: Integer
g_logtopic :: Integer
g_logdata :: Integer
g_log :: Integer
g_transaction :: Integer
g_txdatanonzero :: Integer
g_txdatazero :: Integer
g_txcreate :: Integer
g_memory :: Integer
g_expbyte :: Integer
g_exp :: Integer
g_newaccount :: Integer
g_callstipend :: Integer
g_callvalue :: Integer
g_call :: Integer
g_codedeposit :: Integer
g_create :: Integer
r_selfdestruct :: Integer
g_selfdestruct_newaccount :: Integer
g_selfdestruct :: Integer
r_sclear :: Integer
g_sreset :: Integer
g_sset :: Integer
g_jumpdest :: Integer
g_sload :: Integer
g_balance :: Integer
g_extcode :: Integer
g_high :: Integer
g_mid :: Integer
g_low :: Integer
g_verylow :: Integer
g_base :: Integer
g_zero :: Integer
..} = ((Block -> Const (FeeSchedule Integer) Block)
 -> VM -> Const (FeeSchedule Integer) VM)
-> ((FeeSchedule Integer
     -> Const (FeeSchedule Integer) (FeeSchedule Integer))
    -> Block -> Const (FeeSchedule Integer) Block)
-> FeeSchedule Integer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const (FeeSchedule Integer) Block)
-> VM -> Const (FeeSchedule Integer) VM
Lens' VM Block
block (FeeSchedule Integer
 -> Const (FeeSchedule Integer) (FeeSchedule Integer))
-> Block -> Const (FeeSchedule Integer) Block
Lens' Block (FeeSchedule Integer)
schedule

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

  if Addr
self Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
> Addr
0x0 Bool -> Bool -> Bool
&& Addr
self Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
<= Addr
0x9 then do
    -- call to precompile
    let ?op = 0x00 -- dummy value
    let
      calldatasize :: SymWord
calldatasize = (Buffer, SymWord) -> SymWord
forall a b. (a, b) -> b
snd (((FrameState -> Const (Buffer, SymWord) FrameState)
 -> VM -> Const (Buffer, SymWord) VM)
-> (((Buffer, SymWord)
     -> Const (Buffer, SymWord) (Buffer, SymWord))
    -> FrameState -> Const (Buffer, SymWord) FrameState)
-> (Buffer, SymWord)
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const (Buffer, SymWord) FrameState)
-> VM -> Const (Buffer, SymWord) VM
Lens' VM FrameState
state ((Buffer, SymWord) -> Const (Buffer, SymWord) (Buffer, SymWord))
-> FrameState -> Const (Buffer, SymWord) FrameState
Lens' FrameState (Buffer, SymWord)
calldata)
    case SymWord -> Maybe Word
maybeLitWord SymWord
calldatasize of
        Maybe Word
Nothing -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
        Just Word
calldatasize' -> do
          Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory ((Buffer, SymWord) -> Buffer
forall a b. (a, b) -> a
fst ((Buffer, SymWord) -> Buffer) -> (Buffer, SymWord) -> Buffer
forall a b. (a -> b) -> a -> b
$ ((FrameState -> Const (Buffer, SymWord) FrameState)
 -> VM -> Const (Buffer, SymWord) VM)
-> (((Buffer, SymWord)
     -> Const (Buffer, SymWord) (Buffer, SymWord))
    -> FrameState -> Const (Buffer, SymWord) FrameState)
-> (Buffer, SymWord)
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const (Buffer, SymWord) FrameState)
-> VM -> Const (Buffer, SymWord) VM
Lens' VM FrameState
state ((Buffer, SymWord) -> Const (Buffer, SymWord) (Buffer, SymWord))
-> FrameState -> Const (Buffer, SymWord) FrameState
Lens' FrameState (Buffer, SymWord)
calldata) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
calldatasize') Word
0 Word
0
          (?op::Word8) =>
Addr
-> Integer -> Word -> Word -> Word -> Word -> [SymWord] -> EVM ()
Addr
-> Integer -> Word -> Word -> Word -> Word -> [SymWord] -> EVM ()
executePrecompile Addr
self (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Word -> Integer) -> Word -> Integer
forall a b. (a -> b) -> a -> b
$ ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas) Word
0 (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
calldatasize') Word
0 Word
0 []
          VM
vmx <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
          case Getting [SymWord] VM [SymWord] -> VM -> [SymWord]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const [SymWord] FrameState)
-> VM -> Const [SymWord] VM
Lens' VM FrameState
state((FrameState -> Const [SymWord] FrameState)
 -> VM -> Const [SymWord] VM)
-> (([SymWord] -> Const [SymWord] [SymWord])
    -> FrameState -> Const [SymWord] FrameState)
-> Getting [SymWord] VM [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([SymWord] -> Const [SymWord] [SymWord])
-> FrameState -> Const [SymWord] FrameState
Lens' FrameState [SymWord]
stack) VM
vmx of
            (SymWord
x:[SymWord]
_) -> case SymWord -> Maybe Word
maybeLitWord SymWord
x of
              Just Word
0 -> do
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
self ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                  Addr -> EVM ()
touchAccount Addr
self
                  Error -> EVM ()
vmError Error
PrecompileFailure
              Just Word
_ ->
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
self ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                  Addr -> EVM ()
touchAccount Addr
self
                  Buffer
out <- Getting Buffer VM Buffer -> StateT VM Identity Buffer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
returndata)
                  FrameResult -> EVM ()
finishFrame (Buffer -> FrameResult
FrameReturned Buffer
out)
              Maybe Word
Nothing -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
            [SymWord]
_ ->
              EVM ()
underrun

  else if ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Int
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Buffer -> Int
len (((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
code)
    then EVM ()
doStop

    else do
      let ?op = fromMaybe (error "could not analyze symbolic code") $ unliteral $ EVM.Symbolic.index (the state pc) (the state code)

      case ?op::Word8
Word8
?op of

        -- op: PUSH
        Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7f -> do
          let !n :: Int
n = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num Word8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              !xs :: SymWord
xs = case ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
code of
                      ConcreteBuffer ByteString
b -> W256 -> SymWord
w256lit (W256 -> SymWord) -> W256 -> SymWord
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
padRight Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (Int -> ByteString -> ByteString
BS.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Int
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) ByteString
b)
                      SymbolicBuffer [SWord 8]
b -> Word -> [SWord 8] -> SymWord
readSWord' Word
0 ([SWord 8] -> SymWord) -> [SWord 8] -> SymWord
forall a b. (a -> b) -> a -> b
$ Int -> [SWord 8] -> [SWord 8]
forall a. Num a => Int -> [a] -> [a]
padLeft' Int
32 ([SWord 8] -> [SWord 8]) -> [SWord 8] -> [SWord 8]
forall a b. (a -> b) -> a -> b
$ Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
take Int
n ([SWord 8] -> [SWord 8]) -> [SWord 8] -> [SWord 8]
forall a b. (a -> b) -> a -> b
$ Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Int
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) [SWord 8]
b
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Integer -> EVM () -> EVM ()
burn Integer
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
              EVM ()
(?op::Word8) => EVM ()
next
              SymWord -> EVM ()
pushSym SymWord
xs

        -- op: DUP
        Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x8f -> do
          let !i :: Word8
i = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1
          case Getting (First SymWord) [SymWord] SymWord
-> [SymWord] -> Maybe SymWord
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index [SymWord] -> Traversal' [SymWord] (IxValue [SymWord])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num Word8
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [SymWord]
stk of
            Maybe SymWord
Nothing -> EVM ()
underrun
            Just SymWord
y ->
              Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                Integer -> EVM () -> EVM ()
burn Integer
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  SymWord -> EVM ()
pushSym SymWord
y

        -- op: SWAP
        Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x90 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x9f -> do
          let i :: Int
i = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x90 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1)
          if [SymWord] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymWord]
stk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            then EVM ()
underrun
            else
              Integer -> EVM () -> EVM ()
burn Integer
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                EVM ()
(?op::Word8) => EVM ()
next
                LensLike' (Zoomed (StateT [SymWord] Identity) ()) VM [SymWord]
-> StateT [SymWord] Identity () -> EVM ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((FrameState -> Focusing Identity () FrameState)
-> VM -> Focusing Identity () VM
Lens' VM FrameState
state ((FrameState -> Focusing Identity () FrameState)
 -> VM -> Focusing Identity () VM)
-> (([SymWord] -> Focusing Identity () [SymWord])
    -> FrameState -> Focusing Identity () FrameState)
-> ([SymWord] -> Focusing Identity () [SymWord])
-> VM
-> Focusing Identity () VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Focusing Identity () [SymWord])
-> FrameState -> Focusing Identity () FrameState
Lens' FrameState [SymWord]
stack) (StateT [SymWord] Identity () -> EVM ())
-> StateT [SymWord] Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  ASetter [SymWord] [SymWord] SymWord SymWord
-> SymWord -> StateT [SymWord] Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Index [SymWord] -> Traversal' [SymWord] (IxValue [SymWord])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [SymWord]
0) ([SymWord]
stk [SymWord] -> Getting (Endo SymWord) [SymWord] SymWord -> SymWord
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index [SymWord] -> Traversal' [SymWord] (IxValue [SymWord])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [SymWord]
i)
                  ASetter [SymWord] [SymWord] SymWord SymWord
-> SymWord -> StateT [SymWord] Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Index [SymWord] -> Traversal' [SymWord] (IxValue [SymWord])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [SymWord]
i) ([SymWord]
stk [SymWord] -> Getting (Endo SymWord) [SymWord] SymWord -> SymWord
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index [SymWord] -> Traversal' [SymWord] (IxValue [SymWord])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [SymWord]
0)

        -- op: LOG
        Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xa0 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0xa4 ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          let n :: Int
n = (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num Word8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xa0) in
          case [SymWord]
stk of
            (SymWord
xOffset':SymWord
xSize':[SymWord]
xs) ->
              if [SymWord] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymWord]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
              then EVM ()
underrun
              else
                (SymWord, SymWord) -> ((Word, Word) -> EVM ()) -> EVM ()
forceConcrete2 (SymWord
xOffset', SymWord
xSize') (((Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(Word
xOffset, Word
xSize) -> do
                    let ([SymWord]
topics, [SymWord]
xs') = Int -> [SymWord] -> ([SymWord], [SymWord])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [SymWord]
xs
                        bytes :: Buffer
bytes         = Word -> Word -> VM -> Buffer
readMemory (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) VM
vm
                        log :: Log
log           = Addr -> Buffer -> [SymWord] -> Log
Log Addr
self Buffer
bytes [SymWord]
topics

                    Integer -> EVM () -> EVM ()
burn (Integer
g_log Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_logdata Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
g_logtopic) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                      FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOffset Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                        Log -> EVM ()
forall (m :: * -> *). MonadState VM m => Log -> m ()
traceLog Log
log
                        EVM ()
(?op::Word8) => EVM ()
next
                        ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs'
                        ASetter VM VM (Seq Log) (Seq Log) -> Log -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence ASetter VM VM (Seq Log) (Seq Log)
Lens' VM (Seq Log)
logs Log
log
            [SymWord]
_ ->
              EVM ()
underrun

        -- op: STOP
        Word8
0x00 -> EVM ()
doStop

        -- op: ADD
        Word8
0x01 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) ((SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
forall a. Num a => a -> a -> a
(+))
        -- op: MUL
        Word8
0x02 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_low) ((SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
forall a. Num a => a -> a -> a
(*))
        -- op: SUB
        Word8
0x03 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) ((SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-))

        -- op: DIV
        Word8
0x04 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_low) ((SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SymWord -> SymWord -> SymWord
forall a. SDivisible a => a -> a -> a
sDiv))

        -- op: SDIV
        Word8
0x05 ->
          (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_low) ((SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
sdiv)

        -- op: MOD
        Word8
0x06 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_low) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(S Whiff
a SWord 256
x, S Whiff
b SWord 256
y) -> Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff -> Whiff
ITE (Whiff -> Whiff
IsZero Whiff
b) (W256 -> Whiff
Literal W256
0) (Whiff -> Whiff -> Whiff
Mod Whiff
a Whiff
b)) (SBool -> SWord 256 -> SWord 256 -> SWord 256
forall a. Mergeable a => SBool -> a -> a -> a
ite (SWord 256
y SWord 256 -> SWord 256 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SWord 256
0) SWord 256
0 (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. SDivisible a => a -> a -> a
`sMod` SWord 256
y))

        -- op: SMOD
        Word8
0x07 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_low) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ (SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
smod
        -- op: ADDMOD
        Word8
0x08 -> (?op::Word8) =>
((SymWord, SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord, SymWord) -> SymWord) -> EVM ()
stackOp3 (Integer -> (SymWord, SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_mid) (\(SymWord
x, SymWord
y, SymWord
z) -> SymWord -> SymWord -> SymWord -> SymWord
addmod SymWord
x SymWord
y SymWord
z)
        -- op: MULMOD
        Word8
0x09 -> (?op::Word8) =>
((SymWord, SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord, SymWord) -> SymWord) -> EVM ()
stackOp3 (Integer -> (SymWord, SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_mid) (\(SymWord
x, SymWord
y, SymWord
z) -> SymWord -> SymWord -> SymWord -> SymWord
mulmod SymWord
x SymWord
y SymWord
z)

        -- op: LT
        Word8
0x10 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(S Whiff
a SWord 256
x, S Whiff
b SWord 256
y) -> Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord
iteWhiff (Whiff -> Whiff -> Whiff
LT Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SWord 256
y) SWord 256
1 SWord 256
0
        -- op: GT
        Word8
0x11 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(S Whiff
a SWord 256
x, S Whiff
b SWord 256
y) -> Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord
iteWhiff (Whiff -> Whiff -> Whiff
GT Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SWord 256
y) SWord 256
1 SWord 256
0
        -- op: SLT
        Word8
0x12 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ (SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
slt
        -- op: SGT
        Word8
0x13 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ (SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
sgt

        -- op: EQ
        Word8
0x14 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(S Whiff
a SWord 256
x, S Whiff
b SWord 256
y) -> Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord
iteWhiff (Whiff -> Whiff -> Whiff
Eq Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SWord 256
y) SWord 256
1 SWord 256
0
        -- op: ISZERO
        Word8
0x15 -> (?op::Word8) =>
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
stackOp1 (Integer -> SymWord -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) ((SymWord -> SymWord) -> EVM ()) -> (SymWord -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(S Whiff
a SWord 256
x) -> Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord
iteWhiff (Whiff -> Whiff
IsZero Whiff
a) (SWord 256
x SWord 256 -> SWord 256 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SWord 256
0) SWord 256
1 SWord 256
0

        -- op: AND
        Word8
0x16 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ (SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
forall a. Bits a => a -> a -> a
(.&.)
        -- op: OR
        Word8
0x17 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ (SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
forall a. Bits a => a -> a -> a
(.|.)
        -- op: XOR
        Word8
0x18 -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ (SymWord -> SymWord -> SymWord) -> (SymWord, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymWord -> SymWord -> SymWord
forall a. Bits a => a -> a -> a
xor
        -- op: NOT
        Word8
0x19 -> (?op::Word8) =>
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
stackOp1 (Integer -> SymWord -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) SymWord -> SymWord
forall a. Bits a => a -> a
complement

        -- op: BYTE
        Word8
0x1a -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \case
          (SymWord
n, SymWord
_) | (SymWord -> Word
forceLit SymWord
n) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
32 -> SymWord
0
          (SymWord
n, SymWord
x) | Bool
otherwise          -> SymWord
0xff SymWord -> SymWord -> SymWord
forall a. Bits a => a -> a -> a
.&. SymWord -> Int -> SymWord
forall a. Bits a => a -> Int -> a
shiftR SymWord
x (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
31 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word -> Int
forall a b. (Integral a, Num b) => a -> b
num (SymWord -> Word
forceLit SymWord
n)))

        -- op: SHL
        Word8
0x1b -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \((S Whiff
a SWord 256
n), (S Whiff
b SWord 256
x)) -> Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
SHL Whiff
b Whiff
a) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 256 -> SWord 256
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftLeft SWord 256
x SWord 256
n
        -- op: SHR
        Word8
0x1c -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \((S Whiff
a SWord 256
n), (S Whiff
b SWord 256
x)) -> Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
SHR Whiff
b Whiff
a) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 256 -> SWord 256
forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftRight SWord 256
x SWord 256
n
        -- op: SAR
        Word8
0x1d -> (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \((S Whiff
a SWord 256
n), (S Whiff
b SWord 256
x)) -> Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
SAR Whiff
b Whiff
a) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 256 -> SWord 256
forall a b. (SFiniteBits a, SIntegral b) => SBV a -> SBV b -> SBV a
sSignedShiftArithRight SWord 256
x SWord 256
n

        -- op: SHA3
        -- more accurately refered to as KECCAK
        Word8
0x20 ->
          case [SymWord]
stk of
            (SymWord
xOffset' : SymWord
xSize' : [SymWord]
xs) ->
              SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
xOffset' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \Word
xOffset -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
xSize' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
xSize ->
                  Integer -> EVM () -> EVM ()
burn (Integer
g_sha3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_sha3word Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Integer
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) Integer
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOffset Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      (hash :: SymWord
hash@(S Whiff
_ SWord 256
hash'), Map Word ByteString
invMap, [SWord 8]
bytes) <- case Word -> Word -> VM -> Buffer
readMemory Word
xOffset Word
xSize VM
vm of
                                         ConcreteBuffer ByteString
bs -> do
                                           (SymWord, Map Word ByteString, [SWord 8])
-> StateT VM Identity (SymWord, Map Word ByteString, [SWord 8])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> SymWord
litWord (Word -> SymWord) -> Word -> SymWord
forall a b. (a -> b) -> a -> b
$ ByteString -> Word
keccakBlob ByteString
bs, Word -> ByteString -> Map Word ByteString
forall k a. k -> a -> Map k a
Map.singleton (ByteString -> Word
keccakBlob ByteString
bs) ByteString
bs, ByteString -> [SWord 8]
litBytes ByteString
bs)
                                         SymbolicBuffer [SWord 8]
bs -> do
                                           let hash' :: SWord 256
hash' = [SWord 8] -> SWord 256
symkeccak' [SWord 8]
bs
                                           (SymWord, Map Word ByteString, [SWord 8])
-> StateT VM Identity (SymWord, Map Word ByteString, [SWord 8])
forall (m :: * -> *) a. Monad m => a -> m a
return (Whiff -> SWord 256 -> SymWord
S (Buffer -> Whiff
FromKeccak (Buffer -> Whiff) -> Buffer -> Whiff
forall a b. (a -> b) -> a -> b
$ [SWord 8] -> Buffer
SymbolicBuffer [SWord 8]
bs) SWord 256
hash', Map Word ByteString
forall a. Monoid a => a
mempty, [SWord 8]
bs)

                      -- Although we would like to simply assert that the uninterpreted function symkeccak'
                      -- is injective, this proves to cause a lot of concern for our smt solvers, probably
                      -- due to the introduction of universal quantifiers into the queries.

                      -- Instead, we keep track of all of the particular invocations of symkeccak' we see
                      -- (similarly to sha3Crack), and simply assert that injectivity holds for these
                      -- particular invocations.
                      --
                      -- We additionally make the probabalisitc assumption that the output of symkeccak'
                      -- is greater than 100. This lets us avoid having to reason about storage collisions
                      -- between mappings and "normal" slots

                      let previousUsed :: [([SWord 8], SWord 256)]
previousUsed = Getting [([SWord 8], SWord 256)] VM [([SWord 8], SWord 256)]
-> VM -> [([SWord 8], SWord 256)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const [([SWord 8], SWord 256)] Env)
-> VM -> Const [([SWord 8], SWord 256)] VM
Lens' VM Env
env ((Env -> Const [([SWord 8], SWord 256)] Env)
 -> VM -> Const [([SWord 8], SWord 256)] VM)
-> (([([SWord 8], SWord 256)]
     -> Const [([SWord 8], SWord 256)] [([SWord 8], SWord 256)])
    -> Env -> Const [([SWord 8], SWord 256)] Env)
-> Getting [([SWord 8], SWord 256)] VM [([SWord 8], SWord 256)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([([SWord 8], SWord 256)]
 -> Const [([SWord 8], SWord 256)] [([SWord 8], SWord 256)])
-> Env -> Const [([SWord 8], SWord 256)] Env
Lens' Env [([SWord 8], SWord 256)]
keccakUsed) VM
vm
                      (Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> (([([SWord 8], SWord 256)] -> Identity [([SWord 8], SWord 256)])
    -> Env -> Identity Env)
-> ([([SWord 8], SWord 256)] -> Identity [([SWord 8], SWord 256)])
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([([SWord 8], SWord 256)] -> Identity [([SWord 8], SWord 256)])
-> Env -> Identity Env
Lens' Env [([SWord 8], SWord 256)]
keccakUsed (([([SWord 8], SWord 256)] -> Identity [([SWord 8], SWord 256)])
 -> VM -> Identity VM)
-> [([SWord 8], SWord 256)] -> EVM ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [([SWord 8]
bytes, SWord 256
hash')]
                      ([(SBool, Whiff)] -> Identity [(SBool, Whiff)])
-> VM -> Identity VM
Lens' VM [(SBool, Whiff)]
constraints (([(SBool, Whiff)] -> Identity [(SBool, Whiff)])
 -> VM -> Identity VM)
-> [(SBool, Whiff)] -> EVM ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= (SWord 256
hash' SWord 256 -> SWord 256 -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SWord 256
100, String -> [Whiff] -> Whiff
Todo String
"probabilistic keccak assumption" [])(SBool, Whiff) -> [(SBool, Whiff)] -> [(SBool, Whiff)]
forall a. a -> [a] -> [a]
:
                        ((([SWord 8], SWord 256) -> (SBool, Whiff))
-> [([SWord 8], SWord 256)] -> [(SBool, Whiff)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([SWord 8]
preimage, SWord 256
image) ->
                          -- keccak is a function
                          (([SWord 8]
preimage [SWord 8] -> [SWord 8] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [SWord 8]
bytes SBool -> SBool -> SBool
.=> SWord 256
image SWord 256 -> SWord 256 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SWord 256
hash') SBool -> SBool -> SBool
.&&
                          -- which is injective
                          (SWord 256
image SWord 256 -> SWord 256 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SWord 256
hash' SBool -> SBool -> SBool
.=> [SWord 8]
preimage [SWord 8] -> [SWord 8] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [SWord 8]
bytes), String -> [Whiff] -> Whiff
Todo String
"injective keccak assumption" []))
                         [([SWord 8], SWord 256)]
previousUsed)

                      EVM ()
(?op::Word8) => EVM ()
next
                      ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
hash SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
                      ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Map Word ByteString -> Identity (Map Word ByteString))
    -> Env -> Identity Env)
-> (Map Word ByteString -> Identity (Map Word ByteString))
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Word ByteString -> Identity (Map Word ByteString))
-> Env -> Identity Env
Lens' Env (Map Word ByteString)
sha3Crack) ((Map Word ByteString -> Identity (Map Word ByteString))
 -> VM -> Identity VM)
-> Map Word ByteString -> EVM ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Map Word ByteString
invMap
            [SymWord]
_ -> EVM ()
underrun

        -- op: ADDRESS
        Word8
0x30 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Addr -> Word
forall a b. (Integral a, Num b) => a -> b
num Addr
self))

        -- op: BALANCE
        Word8
0x31 ->
          case [SymWord]
stk of
            (SymWord
x':[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x ->
              Addr -> EVM () -> EVM ()
accessAndBurn (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
x) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
x) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                  Word -> EVM ()
push (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
c)
            [] ->
              EVM ()
underrun

        -- op: ORIGIN
        Word8
0x32 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Addr -> Word
forall a b. (Integral a, Num b) => a -> b
num (((TxState -> Const Addr TxState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr) -> TxState -> Const Addr TxState)
-> Addr
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (TxState -> Const Addr TxState) -> VM -> Const Addr VM
Lens' VM TxState
tx (Addr -> Const Addr Addr) -> TxState -> Const Addr TxState
Lens' TxState Addr
origin))

        -- op: CALLER
        Word8
0x33 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            let toSymWord :: SAddr -> SymWord
                toSymWord :: SAddr -> SymWord
toSymWord (SAddr SWord 160
x) = case SWord 160 -> Maybe (WordN 160)
forall a. SymVal a => SBV a -> Maybe a
unliteral SWord 160
x of
                  Just WordN 160
s -> Word -> SymWord
litWord (Word -> SymWord) -> Word -> SymWord
forall a b. (a -> b) -> a -> b
$ WordN 160 -> Word
forall a b. (Integral a, Num b) => a -> b
num WordN 160
s
                  Maybe (WordN 160)
Nothing -> String -> SWord 256 -> SymWord
var String
"CALLER" (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SWord 160 -> SWord 256
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 160
x
            in EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SymWord -> EVM ()
pushSym (SAddr -> SymWord
toSymWord (((FrameState -> Const SAddr FrameState) -> VM -> Const SAddr VM)
-> ((SAddr -> Const SAddr SAddr)
    -> FrameState -> Const SAddr FrameState)
-> SAddr
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const SAddr FrameState) -> VM -> Const SAddr VM
Lens' VM FrameState
state (SAddr -> Const SAddr SAddr)
-> FrameState -> Const SAddr FrameState
Lens' FrameState SAddr
caller))

        -- op: CALLVALUE
        Word8
0x34 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SymWord -> EVM ()
pushSym (((FrameState -> Const SymWord FrameState)
 -> VM -> Const SymWord VM)
-> ((SymWord -> Const SymWord SymWord)
    -> FrameState -> Const SymWord FrameState)
-> SymWord
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const SymWord FrameState) -> VM -> Const SymWord VM
Lens' VM FrameState
state (SymWord -> Const SymWord SymWord)
-> FrameState -> Const SymWord FrameState
Lens' FrameState SymWord
callvalue)

        -- op: CALLDATALOAD
        Word8
0x35 -> (?op::Word8) =>
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
stackOp1 (Integer -> SymWord -> Integer
forall a b. a -> b -> a
const Integer
g_verylow) ((SymWord -> SymWord) -> EVM ()) -> (SymWord -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$
          \SymWord
ind -> (Buffer -> SymWord -> SymWord) -> (Buffer, SymWord) -> SymWord
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (SymWord -> Buffer -> SymWord -> SymWord
readSWordWithBound SymWord
ind) (((FrameState -> Const (Buffer, SymWord) FrameState)
 -> VM -> Const (Buffer, SymWord) VM)
-> (((Buffer, SymWord)
     -> Const (Buffer, SymWord) (Buffer, SymWord))
    -> FrameState -> Const (Buffer, SymWord) FrameState)
-> (Buffer, SymWord)
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const (Buffer, SymWord) FrameState)
-> VM -> Const (Buffer, SymWord) VM
Lens' VM FrameState
state ((Buffer, SymWord) -> Const (Buffer, SymWord) (Buffer, SymWord))
-> FrameState -> Const (Buffer, SymWord) FrameState
Lens' FrameState (Buffer, SymWord)
calldata)

        -- op: CALLDATASIZE
        Word8
0x36 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SymWord -> EVM ()
pushSym ((Buffer, SymWord) -> SymWord
forall a b. (a, b) -> b
snd (((FrameState -> Const (Buffer, SymWord) FrameState)
 -> VM -> Const (Buffer, SymWord) VM)
-> (((Buffer, SymWord)
     -> Const (Buffer, SymWord) (Buffer, SymWord))
    -> FrameState -> Const (Buffer, SymWord) FrameState)
-> (Buffer, SymWord)
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const (Buffer, SymWord) FrameState)
-> VM -> Const (Buffer, SymWord) VM
Lens' VM FrameState
state ((Buffer, SymWord) -> Const (Buffer, SymWord) (Buffer, SymWord))
-> FrameState -> Const (Buffer, SymWord) FrameState
Lens' FrameState (Buffer, SymWord)
calldata))

        -- op: CALLDATACOPY
        Word8
0x37 ->
          case [SymWord]
stk of
            (SymWord
xTo' : SymWord
xFrom' : SymWord
xSize' : [SymWord]
xs) -> (SymWord, SymWord, SymWord)
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete3 (SymWord
xTo',SymWord
xFrom',SymWord
xSize') (((Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(Word
xTo,Word
xFrom,Word
xSize) ->
              Integer -> EVM () -> EVM ()
burn (Integer
g_verylow Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_copy Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Integer
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) Integer
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessUnboundedMemoryRange FeeSchedule Integer
fees Word
xTo Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                  case ((FrameState -> Const (Buffer, SymWord) FrameState)
 -> VM -> Const (Buffer, SymWord) VM)
-> (((Buffer, SymWord)
     -> Const (Buffer, SymWord) (Buffer, SymWord))
    -> FrameState -> Const (Buffer, SymWord) FrameState)
-> (Buffer, SymWord)
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const (Buffer, SymWord) FrameState)
-> VM -> Const (Buffer, SymWord) VM
Lens' VM FrameState
state ((Buffer, SymWord) -> Const (Buffer, SymWord) (Buffer, SymWord))
-> FrameState -> Const (Buffer, SymWord) FrameState
Lens' FrameState (Buffer, SymWord)
calldata of
                    (SymbolicBuffer [SWord 8]
cd, (S Whiff
_ SWord 256
cdlen)) -> Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory ([SWord 8] -> Buffer
SymbolicBuffer [SBool -> SWord 8 -> SWord 8 -> SWord 8
forall a. Mergeable a => SBool -> a -> a -> a
ite (SWord 256
i SWord 256 -> SWord 256 -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= SWord 256
cdlen) SWord 8
x SWord 8
0 | (SWord 8
x, SWord 256
i) <- [SWord 8] -> [SWord 256] -> [(SWord 8, SWord 256)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SWord 8]
cd [SWord 256
1..]]) Word
xSize Word
xFrom Word
xTo
                    -- when calldata is concrete,
                    -- the bound should always be equal to the bytestring length
                    (Buffer
cd, SymWord
_) -> Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
cd Word
xSize Word
xFrom Word
xTo
            [SymWord]
_ -> EVM ()
underrun

        -- op: CODESIZE
        Word8
0x38 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Buffer -> Int
len (((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
code)))

        -- op: CODECOPY
        Word8
0x39 ->
          case [SymWord]
stk of
            (SymWord
memOffset' : SymWord
codeOffset' : SymWord
n' : [SymWord]
xs) -> (SymWord, SymWord, SymWord)
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete3 (SymWord
memOffset',SymWord
codeOffset',SymWord
n') (((Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(Word
memOffset,Word
codeOffset,Word
n) -> do
              Integer -> EVM () -> EVM ()
burn (Integer
g_verylow Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_copy Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Integer
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
n) Integer
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessUnboundedMemoryRange FeeSchedule Integer
fees Word
memOffset Word
n (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                  Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory (((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
code)
                    Word
n Word
codeOffset Word
memOffset
            [SymWord]
_ -> EVM ()
underrun

        -- op: GASPRICE
        Word8
0x3a ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (((TxState -> Const Word TxState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> TxState -> Const Word TxState)
-> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (TxState -> Const Word TxState) -> VM -> Const Word VM
Lens' VM TxState
tx (Word -> Const Word Word) -> TxState -> Const Word TxState
Lens' TxState Word
gasprice)

        -- op: EXTCODESIZE
        Word8
0x3b ->
          case [SymWord]
stk of
            (SymWord
x':[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique SymWord
x' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x ->
              if Word
x Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Addr -> Word
forall a b. (Integral a, Num b) => a -> b
num Addr
cheatCode
                then do
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                  Word -> EVM ()
push (W256 -> Word
w256 W256
1)
                else
                  Addr -> EVM () -> EVM ()
accessAndBurn (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
x) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
x) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                      EVM ()
(?op::Word8) => EVM ()
next
                      ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                      Word -> EVM ()
push (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Buffer -> Int
len (Getting Buffer Contract Buffer -> Contract -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode Contract
c)))
            [] ->
              EVM ()
underrun

        -- op: EXTCODECOPY
        Word8
0x3c ->
          case [SymWord]
stk of
            ( SymWord
extAccount'
              : SymWord
memOffset'
              : SymWord
codeOffset'
              : SymWord
codeSize'
              : [SymWord]
xs ) ->
              (SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete4 (SymWord
extAccount', SymWord
memOffset', SymWord
codeOffset', SymWord
codeSize') (((Word, Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \(Word
extAccount, Word
memOffset, Word
codeOffset, Word
codeSize) -> do
                  Bool
acc <- Addr -> EVM Bool
accessAccountForGas (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
extAccount)
                  let cost :: Integer
cost = if Bool
acc then Integer
g_warm_storage_read else Integer
g_cold_account_access
                  Integer -> EVM () -> EVM ()
burn (Integer
cost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_copy Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Integer
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
codeSize) Integer
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessUnboundedMemoryRange FeeSchedule Integer
fees Word
memOffset Word
codeSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                      Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
extAccount) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                        EVM ()
(?op::Word8) => EVM ()
next
                        ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                        Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory (Getting Buffer Contract Buffer -> Contract -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode Contract
c)
                          Word
codeSize Word
codeOffset Word
memOffset
            [SymWord]
_ -> EVM ()
underrun

        -- op: RETURNDATASIZE
        Word8
0x3d ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Buffer -> Int
len (((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
returndata))

        -- op: RETURNDATACOPY
        Word8
0x3e ->
          case [SymWord]
stk of
            (SymWord
xTo' : SymWord
xFrom' : SymWord
xSize' :[SymWord]
xs) -> (SymWord, SymWord, SymWord)
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete3 (SymWord
xTo', SymWord
xFrom', SymWord
xSize') (((Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(Word
xTo, Word
xFrom, Word
xSize) ->
                Integer -> EVM () -> EVM ()
burn (Integer
g_verylow Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_copy Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Integer
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) Integer
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessUnboundedMemoryRange FeeSchedule Integer
fees Word
xTo Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    EVM ()
(?op::Word8) => EVM ()
next
                    ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                    if Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Buffer -> Int
len (((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
returndata)) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
xFrom Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
xSize Bool -> Bool -> Bool
|| Word
xFrom Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
xSize Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
xFrom
                    then Error -> EVM ()
vmError Error
InvalidMemoryAccess
                    else Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory (((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Buffer
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
returndata) Word
xSize Word
xFrom Word
xTo
            [SymWord]
_ -> EVM ()
underrun

        -- op: EXTCODEHASH
        Word8
0x3f ->
          case [SymWord]
stk of
            (SymWord
x':[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x ->
              Addr -> EVM () -> EVM ()
accessAndBurn (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
x) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                EVM ()
(?op::Word8) => EVM ()
next
                ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num Word
x) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c ->
                   if Contract -> Bool
accountEmpty Contract
c
                     then Word -> EVM ()
push (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Int
0 :: Int))
                     else case Getting Buffer Contract Buffer -> Contract -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode Contract
c of
                           ConcreteBuffer ByteString
b -> Word -> EVM ()
push (W256 -> Word
forall a b. (Integral a, Num b) => a -> b
num (ByteString -> W256
keccak ByteString
b))
                           b' :: Buffer
b'@(SymbolicBuffer [SWord 8]
b) -> SymWord -> EVM ()
pushSym (Whiff -> SWord 256 -> SymWord
S (Buffer -> Whiff
FromKeccak Buffer
b') (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ [SWord 8] -> SWord 256
symkeccak' [SWord 8]
b)
            [] ->
              EVM ()
underrun

        -- op: BLOCKHASH
        Word8
0x40 -> 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) =>
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
(SymWord -> Integer) -> (SymWord -> SymWord) -> EVM ()
stackOp1 (Integer -> SymWord -> Integer
forall a b. a -> b -> a
const Integer
g_blockhash) ((SymWord -> SymWord) -> EVM ()) -> (SymWord -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$
            \(SymWord -> Word
forceLit -> Word
i) ->
              if Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
256 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< ((Block -> Const Word Block) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Block -> Const Word Block) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Word Block) -> VM -> Const Word VM
Lens' VM Block
block (Word -> Const Word Word) -> Block -> Const Word Block
Lens' Block Word
number Bool -> Bool -> Bool
|| Word
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= ((Block -> Const Word Block) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Block -> Const Word Block) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Word Block) -> VM -> Const Word VM
Lens' VM Block
block (Word -> Const Word Word) -> Block -> Const Word Block
Lens' Block Word
number
              then SymWord
0
              else
                (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
i :: Integer)
                  Integer -> (Integer -> String) -> String
forall a b. a -> (a -> b) -> b
& Integer -> String
forall a. Show a => a -> String
show String -> (String -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& String -> ByteString
Char8.pack ByteString -> (ByteString -> W256) -> W256
forall a b. a -> (a -> b) -> b
& ByteString -> W256
keccak W256 -> (W256 -> SymWord) -> SymWord
forall a b. a -> (a -> b) -> b
& W256 -> SymWord
forall a b. (Integral a, Num b) => a -> b
num

        -- op: COINBASE
        Word8
0x41 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Addr -> Word
forall a b. (Integral a, Num b) => a -> b
num (((Block -> Const Addr Block) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr) -> Block -> Const Addr Block) -> Addr
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Addr Block) -> VM -> Const Addr VM
Lens' VM Block
block (Addr -> Const Addr Addr) -> Block -> Const Addr Block
Lens' Block Addr
coinbase))

        -- op: TIMESTAMP
        Word8
0x42 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SymWord -> EVM ()
pushSym (((Block -> Const SymWord Block) -> VM -> Const SymWord VM)
-> ((SymWord -> Const SymWord SymWord)
    -> Block -> Const SymWord Block)
-> SymWord
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const SymWord Block) -> VM -> Const SymWord VM
Lens' VM Block
block (SymWord -> Const SymWord SymWord) -> Block -> Const SymWord Block
Lens' Block SymWord
timestamp)

        -- op: NUMBER
        Word8
0x43 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (((Block -> Const Word Block) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Block -> Const Word Block) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Word Block) -> VM -> Const Word VM
Lens' VM Block
block (Word -> Const Word Word) -> Block -> Const Word Block
Lens' Block Word
number)

        -- op: DIFFICULTY
        Word8
0x44 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (((Block -> Const Word Block) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Block -> Const Word Block) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Word Block) -> VM -> Const Word VM
Lens' VM Block
block (Word -> Const Word Word) -> Block -> Const Word Block
Lens' Block Word
difficulty)

        -- op: GASLIMIT
        Word8
0x45 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (((Block -> Const Word Block) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Block -> Const Word Block) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Word Block) -> VM -> Const Word VM
Lens' VM Block
block (Word -> Const Word Word) -> Block -> Const Word Block
Lens' Block Word
gaslimit)

        -- op: CHAINID
        Word8
0x46 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (((Env -> Const Word Env) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Env -> Const Word Env) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Env -> Const Word Env) -> VM -> Const Word VM
Lens' VM Env
env (Word -> Const Word Word) -> Env -> Const Word Env
Lens' Env Word
chainId)

        -- op: SELFBALANCE
        Word8
0x47 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_low (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
this)

        -- op: POP
        Word8
0x50 ->
          case [SymWord]
stk of
            (SymWord
_:[SymWord]
xs) -> Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs)
            [SymWord]
_      -> EVM ()
underrun

        -- op: MLOAD
        Word8
0x51 ->
          case [SymWord]
stk of
            (SymWord
x':[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x ->
              Integer -> EVM () -> EVM ()
burn Integer
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                FeeSchedule Integer -> Word -> EVM () -> EVM ()
accessMemoryWord FeeSchedule Integer
fees Word
x (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (Getting SymWord Buffer SymWord -> Buffer -> SymWord
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Word -> Getting SymWord Buffer SymWord
forall (f :: * -> *).
Functor f =>
Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
x)) Buffer
mem SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
            [SymWord]
_ -> EVM ()
underrun

        -- op: MSTORE
        Word8
0x52 ->
          case [SymWord]
stk of
            (SymWord
x':SymWord
y:[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x ->
              Integer -> EVM () -> EVM ()
burn Integer
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                FeeSchedule Integer -> Word -> EVM () -> EVM ()
accessMemoryWord FeeSchedule Integer
fees Word
x (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> ((SymWord -> Identity SymWord) -> Buffer -> Identity Buffer)
-> (SymWord -> Identity SymWord)
-> FrameState
-> Identity FrameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (SymWord -> Identity SymWord) -> Buffer -> Identity Buffer
forall (f :: * -> *).
Functor f =>
Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
x)) SymWord
y
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
            [SymWord]
_ -> EVM ()
underrun

        -- op: MSTORE8
        Word8
0x53 ->
          case [SymWord]
stk of
            (SymWord
x':(S Whiff
_ SWord 256
y):[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x ->
              Integer -> EVM () -> EVM ()
burn Integer
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
x Word
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  let yByte :: SBV (WordN ((7 - 0) + 1))
yByte = Proxy 7 -> Proxy 0 -> SWord 256 -> SBV (WordN ((7 - 0) + 1))
forall (i :: Nat) (j :: Nat) (n :: Nat) (bv :: Nat -> *)
       (proxy :: Nat -> *).
(KnownNat n, IsNonZero n, SymVal (bv n), KnownNat i, KnownNat j,
 (i + 1) <= n, j <= i, IsNonZero ((i - j) + 1)) =>
proxy i -> proxy j -> SBV (bv n) -> SBV (bv ((i - j) + 1))
bvExtract (Proxy 7
forall k (t :: k). Proxy t
Proxy :: Proxy 7) (Proxy 0
forall k (t :: k). Proxy t
Proxy :: Proxy 0) SWord 256
y
                  EVM ()
(?op::Word8) => EVM ()
next
                  ASetter VM VM Buffer Buffer -> (Buffer -> Buffer) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory) (Word -> SWord 8 -> Buffer -> Buffer
setMemoryByte Word
x SWord 8
SBV (WordN ((7 - 0) + 1))
yByte)
                  ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
            [SymWord]
_ -> EVM ()
underrun

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

        -- op: SSTORE
        Word8
0x55 ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [SymWord]
stk of
            (SymWord
x:SymWord
new:[SymWord]
xs) ->
              Addr -> SymWord -> (SymWord -> EVM ()) -> EVM ()
accessStorage Addr
self SymWord
x ((SymWord -> EVM ()) -> EVM ()) -> (SymWord -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \SymWord
current -> do
                Word
availableGas <- Getting Word VM Word -> StateT VM Identity Word
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas)

                if Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
availableGas Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
g_callstipend
                  then FrameResult -> EVM ()
finishFrame (Error -> FrameResult
FrameErrored (Word -> Word -> Error
OutOfGas Word
availableGas (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
g_callstipend)))
                  else do
                    let original :: Word
original = case Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
this of
                                  Concrete Map Word SymWord
_ -> Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
0 (Word -> Map Word Word -> Maybe Word
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SymWord -> Word
forceLit SymWord
x) (Getting (Map Word Word) Contract (Map Word Word)
-> Contract -> Map Word Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word Word) Contract (Map Word Word)
Lens' Contract (Map Word Word)
origStorage Contract
this))
                                  Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
_ -> Word
0 -- we don't use this value anywhere anyway
                        storage_cost :: Integer
storage_cost = case (SymWord -> Maybe Word
maybeLitWord SymWord
current, SymWord -> Maybe Word
maybeLitWord SymWord
new) of
                                 (Just Word
current', Just Word
new') ->
                                    if (Word
current' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
new') then Integer
g_sload
                                    else if (Word
current' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
original) Bool -> Bool -> Bool
&& (Word
original Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) then Integer
g_sset
                                    else if (Word
current' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
original) then Integer
g_sreset
                                    else Integer
g_sload

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

                    Bool
acc <- Addr -> SymWord -> EVM Bool
accessStorageForGas Addr
self SymWord
x
                    let cold_storage_cost :: Integer
cold_storage_cost = if Bool
acc then Integer
0 else Integer
g_cold_sload
                    Integer -> EVM () -> EVM ()
burn (Integer
storage_cost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
cold_storage_cost) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      EVM ()
(?op::Word8) => EVM ()
next
                      ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
                      ASetter VM VM Storage Storage -> (Storage -> Storage) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Env -> Identity Env)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Storage -> Identity Storage)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
self ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ASetter Contract Contract Storage Storage
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage)
                        (SymWord -> SymWord -> Storage -> Storage
writeStorage SymWord
x SymWord
new)

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

        -- op: JUMP
        Word8
0x56 ->
          case [SymWord]
stk of
            (SymWord
x:[SymWord]
xs) ->
              Integer -> EVM () -> EVM ()
burn Integer
g_mid (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x' ->
                Word -> [SymWord] -> EVM ()
forall n. Integral n => n -> [SymWord] -> EVM ()
checkJump Word
x' [SymWord]
xs
            [SymWord]
_ -> EVM ()
underrun

        -- op: JUMPI
        Word8
0x57 -> do
          case [SymWord]
stk of
            (SymWord
x:y :: SymWord
y@(S Whiff
w SWord 256
_):[SymWord]
xs) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
x' ->
                Integer -> EVM () -> EVM ()
burn Integer
g_high (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  let jump :: Bool -> EVM ()
                      jump :: Bool -> EVM ()
jump Bool
True = ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EVM ()
(?op::Word8) => EVM ()
next
                      jump Bool
_    = Word -> [SymWord] -> EVM ()
forall n. Integral n => n -> [SymWord] -> EVM ()
checkJump Word
x' [SymWord]
xs
                  in case SymWord -> Maybe Word
maybeLitWord SymWord
y of
                      Just Word
y' -> Bool -> EVM ()
jump (Word
0 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
y')
                      -- if the jump condition is symbolic, an smt query has to be made.
                      Maybe Word
Nothing -> CodeLocation -> (SBool, Whiff) -> (Bool -> EVM ()) -> EVM ()
askSMT (Addr
self, ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Int
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) (SymWord
0 SymWord -> SymWord -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SymWord
y, Whiff -> Whiff
IsZero Whiff
w) Bool -> EVM ()
jump
            [SymWord]
_ -> EVM ()
underrun

        -- op: PC
        Word8
0x58 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Int
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc))

        -- op: MSIZE
        Word8
0x59 ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Int
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
memorySize))

        -- op: GAS
        Word8
0x5a ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EVM () -> EVM ()
burn Integer
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> EVM ()
push (((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas Word -> Word -> Word
forall a. Num a => a -> a -> a
- Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
g_base)

        -- op: JUMPDEST
        Word8
0x5b -> Integer -> EVM () -> EVM ()
burn Integer
g_jumpdest EVM ()
(?op::Word8) => EVM ()
next

        -- op: EXP
        Word8
0x0a ->
          let cost :: (a, SymWord) -> Integer
cost (a
_ ,(SymWord -> Word
forceLit -> Word
exponent)) =
                if Word
exponent Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
                then Integer
g_exp
                else Integer
g_exp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
g_expbyte Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Int -> Int -> Int
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall b. FiniteBits b => b -> Int
log2 Word
exponent) Int
8)
          in (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (SymWord, SymWord) -> Integer
forall a. (a, SymWord) -> Integer
cost (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \((S Whiff
a SWord 256
x),(S Whiff
b SWord 256
y)) -> Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
Exp Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall b e. (Mergeable b, Num b, SIntegral e) => b -> SBV e -> b
.^ SWord 256
y)

        -- op: SIGNEXTEND
        Word8
0x0b ->
          (?op::Word8) =>
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
((SymWord, SymWord) -> Integer)
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
stackOp2 (Integer -> (SymWord, SymWord) -> Integer
forall a b. a -> b -> a
const Integer
g_low) (((SymWord, SymWord) -> SymWord) -> EVM ())
-> ((SymWord, SymWord) -> SymWord) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \((SymWord -> Word
forceLit -> Word
bytes), w :: SymWord
w@(S Whiff
a SWord 256
x)) ->
            if Word
bytes Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
32 then SymWord
w
            else let n :: Int
n = Word -> Int
forall a b. (Integral a, Num b) => a -> b
num Word
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 in
              Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo String
"signextend" [Whiff
a]) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SBool -> SWord 256 -> SWord 256 -> SWord 256
forall a. Mergeable a => SBool -> a -> a -> a
ite (SWord 256 -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SWord 256
x Int
n)
                                          (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Bits a => a -> a -> a
.|. SWord 256 -> SWord 256
forall a. Bits a => a -> a
complement (Int -> SWord 256
forall a. Bits a => Int -> a
bit Int
n SWord 256 -> SWord 256 -> SWord 256
forall a. Num a => a -> a -> a
- SWord 256
1))
                                          (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Bits a => a -> a -> a
.&. (Int -> SWord 256
forall a. Bits a => Int -> a
bit Int
n SWord 256 -> SWord 256 -> SWord 256
forall a. Num a => a -> a -> a
- SWord 256
1))

        -- op: CREATE
        Word8
0xf0 ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [SymWord]
stk of
            (SymWord
xValue' : SymWord
xOffset' : SymWord
xSize' : [SymWord]
xs) -> (SymWord, SymWord, SymWord)
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete3 (SymWord
xValue', SymWord
xOffset', SymWord
xSize') (((Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(Word
xValue, Word
xOffset, Word
xSize) -> do
                FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOffset Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  Word
availableGas <- Getting Word VM Word -> StateT VM Identity Word
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas)
                  let
                    newAddr :: Addr
newAddr = Addr -> W256 -> Addr
createAddress Addr
self (Word -> W256
wordValue (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
this))
                    (Integer
cost, Integer
gas') = FeeSchedule Integer -> Word -> Word -> (Integer, Integer)
costOfCreate FeeSchedule Integer
fees Word
availableGas Word
0
                  Bool
_ <- Addr -> EVM Bool
accessAccountForGas Addr
newAddr
                  Integer -> EVM () -> EVM ()
burn (Integer
cost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
gas') (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    let initCode :: Buffer
initCode = Word -> Word -> VM -> Buffer
readMemory (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) VM
vm
                    in (?op::Word8) =>
Addr
-> Contract
-> Word
-> Word
-> [SymWord]
-> Addr
-> Buffer
-> EVM ()
Addr
-> Contract
-> Word
-> Word
-> [SymWord]
-> Addr
-> Buffer
-> EVM ()
create Addr
self Contract
this (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
gas') Word
xValue [SymWord]
xs Addr
newAddr Buffer
initCode
            [SymWord]
_ -> EVM ()
underrun

        -- op: CALL
        Word8
0xf1 ->
          case [SymWord]
stk of
            ( SymWord
xGas'
              : S Whiff
_ SWord 256
xTo
              : (SymWord -> Word
forceLit -> Word
xValue)
              : SymWord
xInOffset'
              : SymWord
xInSize'
              : SymWord
xOutOffset'
              : SymWord
xOutSize'
              : [SymWord]
xs
             ) -> (SymWord, SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete5 (SymWord
xGas',SymWord
xInOffset', SymWord
xInSize', SymWord
xOutOffset', SymWord
xOutSize') (((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(Word
xGas, Word
xInOffset, Word
xInSize, Word
xOutOffset, Word
xOutSize) ->
                (if Word
xValue Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 then EVM () -> EVM ()
notStatic else EVM () -> EVM ()
forall a. a -> a
id) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  let target :: SAddr
target = SWord 160 -> SAddr
SAddr (SWord 160 -> SAddr) -> SWord 160 -> SAddr
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 160
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 256
xTo in
                  (?op::Word8) =>
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word
xGas SAddr
target SAddr
target Word
xValue Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
callee -> do
                    LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
-> StateT FrameState Identity () -> EVM ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
Lens' VM FrameState
state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      ((SymWord -> Identity SymWord)
 -> FrameState -> Identity FrameState)
-> SymWord -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (SymWord -> Identity SymWord) -> FrameState -> Identity FrameState
Lens' FrameState SymWord
callvalue (Word -> SymWord
litWord Word
xValue)
                      ASetter FrameState FrameState SAddr SAddr
-> SAddr -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState SAddr SAddr
Lens' FrameState SAddr
caller (Addr -> SAddr
litAddr Addr
self)
                      ASetter FrameState FrameState Addr Addr
-> Addr -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
contract Addr
callee
                    Addr -> Addr -> Word -> EVM ()
transfer Addr
self Addr
callee Word
xValue
                    Addr -> EVM ()
touchAccount Addr
self
                    Addr -> EVM ()
touchAccount Addr
callee
            [SymWord]
_ ->
              EVM ()
underrun

        -- op: CALLCODE
        Word8
0xf2 ->
          case [SymWord]
stk of
            ( SymWord
xGas'
              : S Whiff
_ SWord 256
xTo'
              : (SymWord -> Word
forceLit -> Word
xValue)
              : SymWord
xInOffset'
              : SymWord
xInSize'
              : SymWord
xOutOffset'
              : SymWord
xOutSize'
              : [SymWord]
xs
              ) -> (SymWord, SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete5 (SymWord
xGas', SymWord
xInOffset', SymWord
xInSize', SymWord
xOutOffset', SymWord
xOutSize') (((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \(Word
xGas, Word
xInOffset, Word
xInSize, Word
xOutOffset, Word
xOutSize) ->
                  let target :: SAddr
target = SWord 160 -> SAddr
SAddr (SWord 160 -> SAddr) -> SWord 160 -> SAddr
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 160
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 256
xTo' in
                  (?op::Word8) =>
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word
xGas SAddr
target (Addr -> SAddr
litAddr Addr
self) Word
xValue Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
_ -> do
                    LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
-> StateT FrameState Identity () -> EVM ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
Lens' VM FrameState
state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      ((SymWord -> Identity SymWord)
 -> FrameState -> Identity FrameState)
-> SymWord -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (SymWord -> Identity SymWord) -> FrameState -> Identity FrameState
Lens' FrameState SymWord
callvalue (Word -> SymWord
litWord Word
xValue)
                      ASetter FrameState FrameState SAddr SAddr
-> SAddr -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState SAddr SAddr
Lens' FrameState SAddr
caller (Addr -> SAddr
litAddr Addr
self)
                    Addr -> EVM ()
touchAccount Addr
self
            [SymWord]
_ ->
              EVM ()
underrun

        -- op: RETURN
        Word8
0xf3 ->
          case [SymWord]
stk of
            (SymWord
xOffset' : SymWord
xSize' :[SymWord]
_) -> (SymWord, SymWord) -> ((Word, Word) -> EVM ()) -> EVM ()
forceConcrete2 (SymWord
xOffset', SymWord
xSize') (((Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(Word
xOffset, Word
xSize) ->
              FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOffset Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                let
                  output :: Buffer
output = Word -> Word -> VM -> Buffer
readMemory Word
xOffset Word
xSize VM
vm
                  codesize :: Word
codesize = Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Buffer -> Int
len Buffer
output)
                  maxsize :: Word
maxsize = ((Block -> Const Word Block) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> Block -> Const Word Block) -> Word
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (Block -> Const Word Block) -> VM -> Const Word VM
Lens' VM Block
block (Word -> Const Word Word) -> Block -> Const Word Block
Lens' Block Word
maxCodeSize
                case Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
vm of
                  [] ->
                    case (((TxState -> Const Bool TxState) -> VM -> Const Bool VM)
-> ((Bool -> Const Bool Bool) -> TxState -> Const Bool TxState)
-> Bool
forall b a. (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
the (TxState -> Const Bool TxState) -> VM -> Const Bool VM
Lens' VM TxState
tx (Bool -> Const Bool Bool) -> TxState -> Const Bool TxState
Lens' TxState Bool
isCreate) of
                      Bool
True ->
                        if Word
codesize Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
maxsize
                        then
                          FrameResult -> EVM ()
finishFrame (Error -> FrameResult
FrameErrored (Word -> Word -> Error
MaxCodeSizeExceeded Word
maxsize Word
codesize))
                        else
                          Integer -> EVM () -> EVM ()
burn (Integer
g_codedeposit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
codesize) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                            FrameResult -> EVM ()
finishFrame (Buffer -> FrameResult
FrameReturned Buffer
output)
                      Bool
False ->
                        FrameResult -> EVM ()
finishFrame (Buffer -> FrameResult
FrameReturned Buffer
output)
                  (Frame
frame: [Frame]
_) -> do
                    let
                      context :: FrameContext
context = Getting FrameContext Frame FrameContext -> Frame -> FrameContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameContext Frame FrameContext
Lens' Frame FrameContext
frameContext Frame
frame
                    case FrameContext
context of
                      CreationContext {} ->
                        if Word
codesize Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
maxsize
                        then
                          FrameResult -> EVM ()
finishFrame (Error -> FrameResult
FrameErrored (Word -> Word -> Error
MaxCodeSizeExceeded Word
maxsize Word
codesize))
                        else
                          Integer -> EVM () -> EVM ()
burn (Integer
g_codedeposit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
codesize) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                            FrameResult -> EVM ()
finishFrame (Buffer -> FrameResult
FrameReturned Buffer
output)
                      CallContext {} ->
                          FrameResult -> EVM ()
finishFrame (Buffer -> FrameResult
FrameReturned Buffer
output)
            [SymWord]
_ -> EVM ()
underrun

        -- op: DELEGATECALL
        Word8
0xf4 ->
          case [SymWord]
stk of
            (SymWord
xGas'
             :S Whiff
_ SWord 256
xTo
             :SymWord
xInOffset'
             :SymWord
xInSize'
             :SymWord
xOutOffset'
             :SymWord
xOutSize'
             :[SymWord]
xs) -> (SymWord, SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete5 (SymWord
xGas', SymWord
xInOffset', SymWord
xInSize', SymWord
xOutOffset', SymWord
xOutSize') (((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(Word
xGas, Word
xInOffset, Word
xInSize, Word
xOutOffset, Word
xOutSize) ->
                let target :: SAddr
target = SWord 160 -> SAddr
SAddr (SWord 160 -> SAddr) -> SWord 160 -> SAddr
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 160
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 256
xTo in
                (?op::Word8) =>
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word
xGas SAddr
target (Addr -> SAddr
litAddr Addr
self) Word
0 Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
_ -> do
                  Addr -> EVM ()
touchAccount Addr
self
            [SymWord]
_ -> EVM ()
underrun

        -- op: CREATE2
        Word8
0xf5 -> EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [SymWord]
stk of
            (SymWord
xValue'
             :SymWord
xOffset'
             :SymWord
xSize'
             :SymWord
xSalt'
             :[SymWord]
xs) -> (SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete4 (SymWord
xValue', SymWord
xOffset', SymWord
xSize', SymWord
xSalt') (((Word, Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(Word
xValue, Word
xOffset, Word
xSize, Word
xSalt) ->
                FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOffset Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  Word
availableGas <- Getting Word VM Word -> StateT VM Identity Word
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas)

                  Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer (Word -> Word -> VM -> Buffer
readMemory (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xSize) VM
vm) ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
initCode -> do
                   let
                    newAddr :: Addr
newAddr  = Addr -> W256 -> ByteString -> Addr
create2Address Addr
self (Word -> W256
forall a b. (Integral a, Num b) => a -> b
num Word
xSalt) ByteString
initCode
                    (Integer
cost, Integer
gas') = FeeSchedule Integer -> Word -> Word -> (Integer, Integer)
costOfCreate FeeSchedule Integer
fees Word
availableGas Word
xSize
                   Bool
_ <- Addr -> EVM Bool
accessAccountForGas Addr
newAddr
                   Integer -> EVM () -> EVM ()
burn (Integer
cost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
gas') (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    (?op::Word8) =>
Addr
-> Contract
-> Word
-> Word
-> [SymWord]
-> Addr
-> Buffer
-> EVM ()
Addr
-> Contract
-> Word
-> Word
-> [SymWord]
-> Addr
-> Buffer
-> EVM ()
create Addr
self Contract
this (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
gas') Word
xValue [SymWord]
xs Addr
newAddr (ByteString -> Buffer
ConcreteBuffer ByteString
initCode)
            [SymWord]
_ -> EVM ()
underrun

        -- op: STATICCALL
        Word8
0xfa ->
          case [SymWord]
stk of
            (SymWord
xGas'
             :S Whiff
_ SWord 256
xTo
             :SymWord
xInOffset'
             :SymWord
xInSize'
             :SymWord
xOutOffset'
             :SymWord
xOutSize'
             :[SymWord]
xs) -> (SymWord, SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete5 (SymWord
xGas', SymWord
xInOffset', SymWord
xInSize', SymWord
xOutOffset', SymWord
xOutSize') (((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(Word
xGas, Word
xInOffset, Word
xInSize, Word
xOutOffset, Word
xOutSize) -> do
                let target :: SAddr
target = SWord 160 -> SAddr
SAddr (SWord 160 -> SAddr) -> SWord 160 -> SAddr
forall a b. (a -> b) -> a -> b
$ SWord 256 -> SWord 160
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 256
xTo
                (?op::Word8) =>
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word
xGas SAddr
target SAddr
target Word
0 Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
callee -> do
                  LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
-> StateT FrameState Identity () -> EVM ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
Lens' VM FrameState
state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    ((SymWord -> Identity SymWord)
 -> FrameState -> Identity FrameState)
-> SymWord -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (SymWord -> Identity SymWord) -> FrameState -> Identity FrameState
Lens' FrameState SymWord
callvalue SymWord
0
                    ASetter FrameState FrameState SAddr SAddr
-> SAddr -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState SAddr SAddr
Lens' FrameState SAddr
caller (Addr -> SAddr
litAddr Addr
self)
                    ASetter FrameState FrameState Addr Addr
-> Addr -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
contract Addr
callee
                    ASetter FrameState FrameState Bool Bool
-> Bool -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState Bool Bool
Lens' FrameState Bool
static Bool
True
                  Addr -> EVM ()
touchAccount Addr
self
                  Addr -> EVM ()
touchAccount Addr
callee
            [SymWord]
_ ->
              EVM ()
underrun

        -- op: SELFDESTRUCT
        Word8
0xff ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [SymWord]
stk of
            [] -> EVM ()
underrun
            (SymWord
xTo':[SymWord]
_) -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
xTo' ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(Word -> Addr
forall a b. (Integral a, Num b) => a -> b
num -> Addr
xTo) -> do
              Bool
acc <- Addr -> EVM Bool
accessAccountForGas (Addr -> Addr
forall a b. (Integral a, Num b) => a -> b
num Addr
xTo)
              let cost :: Integer
cost = if Bool
acc then Integer
0 else Integer
g_cold_account_access
                  funds :: Word
funds = Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
this
                  recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xTo VM
vm
                  c_new :: Integer
c_new = if Bool -> Bool
not Bool
recipientExists Bool -> Bool -> Bool
&& Word
funds Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
                          then Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
num Integer
g_selfdestruct_newaccount
                          else Integer
0
              Integer -> EVM () -> EVM ()
burn (Integer
g_selfdestruct Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c_new Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
cost) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                   [Addr]
destructs <- Getting [Addr] VM [Addr] -> StateT VM Identity [Addr]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM
Lens' VM TxState
tx ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM)
-> (([Addr] -> Const [Addr] [Addr])
    -> TxState -> Const [Addr] TxState)
-> Getting [Addr] VM [Addr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const [Addr] SubState)
-> TxState -> Const [Addr] TxState
Lens' TxState SubState
substate ((SubState -> Const [Addr] SubState)
 -> TxState -> Const [Addr] TxState)
-> (([Addr] -> Const [Addr] [Addr])
    -> SubState -> Const [Addr] SubState)
-> ([Addr] -> Const [Addr] [Addr])
-> TxState
-> Const [Addr] TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Addr] -> Const [Addr] [Addr])
-> SubState -> Const [Addr] SubState
Lens' SubState [Addr]
selfdestructs)
                   Bool -> EVM () -> EVM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Addr -> [Addr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Addr
self [Addr]
destructs) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ Integer -> EVM ()
refund Integer
r_selfdestruct
                   Addr -> EVM ()
selfdestruct Addr
self
                   Addr -> EVM ()
touchAccount Addr
xTo

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

        -- op: REVERT
        Word8
0xfd ->
          case [SymWord]
stk of
            (SymWord
xOffset':SymWord
xSize':[SymWord]
_) -> (SymWord, SymWord) -> ((Word, Word) -> EVM ()) -> EVM ()
forceConcrete2 (SymWord
xOffset', SymWord
xSize') (((Word, Word) -> EVM ()) -> EVM ())
-> ((Word, Word) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(Word
xOffset, Word
xSize) ->
              FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOffset Word
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                let output :: Buffer
output = Word -> Word -> VM -> Buffer
readMemory Word
xOffset Word
xSize VM
vm
                FrameResult -> EVM ()
finishFrame (Buffer -> FrameResult
FrameReverted Buffer
output)
            [SymWord]
_ -> EVM ()
underrun

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

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

-- | Checks a *CALL for failure; OOG, too many callframes, memory access etc.
callChecks
  :: (?op :: Word8)
  => Contract -> Word -> Addr -> Addr -> Word -> Word -> Word -> Word -> Word -> [SymWord]
   -- continuation with gas available for call
  -> (Integer -> EVM ())
  -> EVM ()
callChecks :: Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Integer -> EVM ())
-> EVM ()
callChecks Contract
this Word
xGas Addr
xContext Addr
xTo Word
xValue Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs Integer -> EVM ()
continue = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let fees :: FeeSchedule Integer
fees = Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
-> VM -> FeeSchedule Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Block -> Const (FeeSchedule Integer) Block)
-> VM -> Const (FeeSchedule Integer) VM
Lens' VM Block
block ((Block -> Const (FeeSchedule Integer) Block)
 -> VM -> Const (FeeSchedule Integer) VM)
-> ((FeeSchedule Integer
     -> Const (FeeSchedule Integer) (FeeSchedule Integer))
    -> Block -> Const (FeeSchedule Integer) Block)
-> Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FeeSchedule Integer
 -> Const (FeeSchedule Integer) (FeeSchedule Integer))
-> Block -> Const (FeeSchedule Integer) Block
Lens' Block (FeeSchedule Integer)
schedule) VM
vm
  FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xInOffset Word
xInSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
    FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
xOutOffset Word
xOutSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
      Word
availableGas <- Getting Word VM Word -> StateT VM Identity Word
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas)
      let recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xContext VM
vm
      (Integer
cost, Integer
gas') <- FeeSchedule Integer
-> Bool -> Word -> Word -> Word -> Addr -> EVM (Integer, Integer)
costOfCall FeeSchedule Integer
fees Bool
recipientExists Word
xValue Word
availableGas Word
xGas Addr
xTo
      Integer -> EVM () -> EVM ()
burn (Integer
cost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
gas') (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
        if Word
xValue Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
this
        then do
          ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
          ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
forall a. Monoid a => a
mempty
          TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace (Error -> TraceData) -> Error -> TraceData
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Error
BalanceTooLow Word
xValue (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
this)
          EVM ()
(?op::Word8) => EVM ()
next
        else if [Frame] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
vm) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024
             then do
               ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
               ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
forall a. Monoid a => a
mempty
               TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
CallDepthLimitReached
               EVM ()
(?op::Word8) => EVM ()
next
             else Integer -> EVM ()
continue Integer
gas'

precompiledContract
  :: (?op :: Word8)
  => Contract
  -> Word
  -> Addr
  -> Addr
  -> Word
  -> Word -> Word -> Word -> Word
  -> [SymWord]
  -> EVM ()
precompiledContract :: Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> EVM ()
precompiledContract Contract
this Word
xGas Addr
precompileAddr Addr
recipient Word
xValue Word
inOffset Word
inSize Word
outOffset Word
outSize [SymWord]
xs =
  (?op::Word8) =>
Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Integer -> EVM ())
-> EVM ()
Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Integer -> EVM ())
-> EVM ()
callChecks Contract
this Word
xGas Addr
recipient Addr
precompileAddr Word
xValue Word
inOffset Word
inSize Word
outOffset Word
outSize [SymWord]
xs ((Integer -> EVM ()) -> EVM ()) -> (Integer -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Integer
gas' ->
  do
    (?op::Word8) =>
Addr
-> Integer -> Word -> Word -> Word -> Word -> [SymWord] -> EVM ()
Addr
-> Integer -> Word -> Word -> Word -> Word -> [SymWord] -> EVM ()
executePrecompile Addr
precompileAddr Integer
gas' Word
inOffset Word
inSize Word
outOffset Word
outSize [SymWord]
xs
    Addr
self <- Getting Addr VM Addr -> StateT VM Identity Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract)
    [SymWord]
stk <- Getting [SymWord] VM [SymWord] -> StateT VM Identity [SymWord]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const [SymWord] FrameState)
-> VM -> Const [SymWord] VM
Lens' VM FrameState
state ((FrameState -> Const [SymWord] FrameState)
 -> VM -> Const [SymWord] VM)
-> (([SymWord] -> Const [SymWord] [SymWord])
    -> FrameState -> Const [SymWord] FrameState)
-> Getting [SymWord] VM [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Const [SymWord] [SymWord])
-> FrameState -> Const [SymWord] FrameState
Lens' FrameState [SymWord]
stack)
    case [SymWord]
stk of
      (SymWord
x:[SymWord]
_) -> case SymWord -> Maybe Word
maybeLitWord SymWord
x of
        Just Word
0 ->
          () -> EVM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Word
1 ->
          Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
recipient ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do

          Addr -> Addr -> Word -> EVM ()
transfer Addr
self Addr
recipient Word
xValue
          Addr -> EVM ()
touchAccount Addr
self
          Addr -> EVM ()
touchAccount Addr
recipient
        Maybe Word
_ -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
      [SymWord]
_ -> EVM ()
underrun

executePrecompile
  :: (?op :: Word8)
  => Addr
  -> Integer -> Word -> Word -> Word -> Word -> [SymWord]
  -> EVM ()
executePrecompile :: Addr
-> Integer -> Word -> Word -> Word -> Word -> [SymWord] -> EVM ()
executePrecompile Addr
preCompileAddr Integer
gasCap Word
inOffset Word
inSize Word
outOffset Word
outSize [SymWord]
xs  = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let input :: Buffer
input = Word -> Word -> VM -> Buffer
readMemory (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
inOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
inSize) VM
vm
      fees :: FeeSchedule Integer
fees = Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
-> VM -> FeeSchedule Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Block -> Const (FeeSchedule Integer) Block)
-> VM -> Const (FeeSchedule Integer) VM
Lens' VM Block
block ((Block -> Const (FeeSchedule Integer) Block)
 -> VM -> Const (FeeSchedule Integer) VM)
-> ((FeeSchedule Integer
     -> Const (FeeSchedule Integer) (FeeSchedule Integer))
    -> Block -> Const (FeeSchedule Integer) Block)
-> Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FeeSchedule Integer
 -> Const (FeeSchedule Integer) (FeeSchedule Integer))
-> Block -> Const (FeeSchedule Integer) Block
Lens' Block (FeeSchedule Integer)
schedule) VM
vm
      cost :: Integer
cost = FeeSchedule Integer -> Addr -> Buffer -> Integer
costOfPrecompile FeeSchedule Integer
fees Addr
preCompileAddr Buffer
input
      notImplemented :: EVM ()
notImplemented = String -> EVM ()
forall a. HasCallStack => String -> a
error (String -> EVM ()) -> String -> EVM ()
forall a b. (a -> b) -> a -> b
$ String
"precompile at address " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Addr -> String
forall a. Show a => a -> String
show Addr
preCompileAddr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not yet implemented"
      precompileFail :: EVM ()
precompileFail = Integer -> EVM () -> EVM ()
burn (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
num Integer
gasCap Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
cost) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                         ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
                         TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
PrecompileFailure
                         EVM ()
(?op::Word8) => EVM ()
next
  if Integer
cost Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
num Integer
gasCap then
    Integer -> EVM () -> EVM ()
burn (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
num Integer
gasCap) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
      ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
      EVM ()
(?op::Word8) => EVM ()
next
  else
    Integer -> EVM () -> EVM ()
burn Integer
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
      case Addr
preCompileAddr of
        -- ECRECOVER
        Addr
0x1 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->
          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
              ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
              ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
forall a. Monoid a => a
mempty
              EVM ()
(?op::Word8) => EVM ()
next
            Just ByteString
output -> do
              ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
              ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) (ByteString -> Buffer
ConcreteBuffer ByteString
output)
              Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory (ByteString -> Buffer
ConcreteBuffer ByteString
output) Word
outSize Word
0 Word
outOffset
              EVM ()
(?op::Word8) => EVM ()
next

        -- SHA2-256
        Addr
0x2 ->
          let
            hash :: Buffer
hash = case Buffer
input of
                     ConcreteBuffer ByteString
input' -> ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
input' :: Digest SHA256)
                     SymbolicBuffer [SWord 8]
input' -> [SWord 8] -> Buffer
SymbolicBuffer ([SWord 8] -> Buffer) -> [SWord 8] -> Buffer
forall a b. (a -> b) -> a -> b
$ [SWord 8] -> [SWord 8]
symSHA256 [SWord 8]
input'
          in do
            ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
            ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
hash
            Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
hash Word
outSize Word
0 Word
outOffset
            EVM ()
(?op::Word8) => EVM ()
next

        -- RIPEMD-160
        Addr
0x3 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->

          let
            padding :: ByteString
padding = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
12 Word8
0
            hash' :: ByteString
hash' = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest RIPEMD160 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (ByteString -> Digest RIPEMD160
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
input' :: Digest RIPEMD160)
            hash :: Buffer
hash  = ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ ByteString
padding ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
hash'
          in do
            ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
            ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
hash
            Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
hash Word
outSize Word
0 Word
outOffset
            EVM ()
(?op::Word8) => EVM ()
next

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

        -- MODEXP
        Addr
0x5 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->

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

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

        -- ECADD
        Addr
0x6 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
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 :: Buffer
truncpaddedOutput = ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
            ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
            ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
truncpaddedOutput
            Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
truncpaddedOutput Word
outSize Word
0 Word
outOffset
            EVM ()
(?op::Word8) => EVM ()
next

        -- ECMUL
        Addr
0x7 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
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 :: Buffer
truncpaddedOutput = ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
            ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
            ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
truncpaddedOutput
            Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
truncpaddedOutput Word
outSize Word
0 Word
outOffset
            EVM ()
(?op::Word8) => EVM ()
next

        -- ECPAIRING
        Addr
0x8 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
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 :: Buffer
truncpaddedOutput = ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
32 ByteString
output
            ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
            ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
truncpaddedOutput
            Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
truncpaddedOutput Word
outSize Word
0 Word
outOffset
            EVM ()
(?op::Word8) => EVM ()
next

        -- BLAKE2
        Addr
0x9 ->
         -- TODO: support symbolic variant
         Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
input ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do

          case (ByteString -> Int
BS.length ByteString
input', Word8
1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 :: Buffer
truncpaddedOutput = ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
                ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
1 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
                ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
truncpaddedOutput
                Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
truncpaddedOutput Word
outSize Word
0 Word
outOffset
                EVM ()
(?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 Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Word8
0)
  where m :: Int
m = ByteString -> Int
BS.length ByteString
xs

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

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

--- checks if a range of ByteString bs starting at offset and length size is all zeros.
isZero :: Word -> Word -> ByteString -> Bool
isZero :: Word -> Word -> ByteString -> Bool
isZero Word
offset Word
size ByteString
bs =
  (Word8 -> Bool) -> ByteString -> Bool
LS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$
    Int64 -> ByteString -> ByteString
LS.take (Word -> Int64
forall a b. (Integral a, Num b) => a -> b
num Word
size) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      Int64 -> ByteString -> ByteString
LS.drop (Word -> Int64
forall a b. (Integral a, Num b) => a -> b
num Word
offset) (ByteString -> ByteString) -> ByteString -> ByteString
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 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty then Integer
0
  else Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ByteString -> Integer
asInteger (ByteString -> ByteString
LS.init ByteString
xs)
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
num (ByteString -> Word8
LS.last ByteString
xs)

-- * Opcode helper actions

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

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

pushToSequence :: MonadState s m => ASetter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence :: 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 ASetter s s (Seq a) (Seq a) -> (Seq a -> Seq a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
x)

getCodeLocation :: VM -> CodeLocation
getCodeLocation :: VM -> CodeLocation
getCodeLocation VM
vm = (Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract) VM
vm, Getting Int VM Int -> VM -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) VM
vm)

-- | Ask the SMT solver to provide a concrete model for val iff a unique model exists
makeUnique :: SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique :: SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique sw :: SymWord
sw@(S Whiff
w SWord 256
val) Word -> EVM ()
cont = case SymWord -> Maybe Word
maybeLitWord SymWord
sw of
  Maybe Word
Nothing -> do
    [(SBool, Whiff)]
conditions <- Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
-> StateT VM Identity [(SBool, Whiff)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
Lens' VM [(SBool, Whiff)]
constraints
    ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (Query -> Maybe VMResult) -> Query -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> (Query -> VMResult) -> Query -> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure (Error -> VMResult) -> (Query -> Error) -> Query -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query (Query -> EVM ()) -> Query -> EVM ()
forall a b. (a -> b) -> a -> b
$ SWord 256 -> [SBool] -> (IsUnique (WordN 256) -> EVM ()) -> Query
forall a.
SymVal a =>
SBV a -> [SBool] -> (IsUnique a -> EVM ()) -> Query
PleaseMakeUnique SWord 256
val ((SBool, Whiff) -> SBool
forall a b. (a, b) -> a
fst ((SBool, Whiff) -> SBool) -> [(SBool, Whiff)] -> [SBool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SBool, Whiff)]
conditions) ((IsUnique (WordN 256) -> EVM ()) -> Query)
-> (IsUnique (WordN 256) -> EVM ()) -> Query
forall a b. (a -> b) -> a -> b
$ \case
      Unique WordN 256
a -> do
        ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result Maybe VMResult
forall a. Maybe a
Nothing
        Word -> EVM ()
cont (Whiff -> W256 -> Word
C Whiff
w (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ WordN 256 -> FromSizzle (WordN 256)
forall a. FromSizzleBV a => a -> FromSizzle a
fromSizzle WordN 256
a)
      IsUnique (WordN 256)
InconsistentU -> Error -> EVM ()
vmError Error
DeadPath
      IsUnique (WordN 256)
TimeoutU -> Error -> EVM ()
vmError Error
SMTTimeout
      IsUnique (WordN 256)
Multiple -> Error -> EVM ()
vmError (Error -> EVM ()) -> Error -> EVM ()
forall a b. (a -> b) -> a -> b
$ Whiff -> Error
NotUnique Whiff
w
  Just Word
a -> Word -> EVM ()
cont Word
a

-- | Construct SMT Query and halt execution until resolved
askSMT :: CodeLocation -> (SBool, Whiff) -> (Bool -> EVM ()) -> EVM ()
askSMT :: CodeLocation -> (SBool, Whiff) -> (Bool -> EVM ()) -> EVM ()
askSMT CodeLocation
codeloc (SBool
condition, Whiff
whiff) Bool -> EVM ()
continue = do
  -- We keep track of how many times we have come across this particular
  -- (contract, pc) combination in the `iteration` mapping.
  Int
iteration <- Getting Int VM Int -> StateT VM Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map CodeLocation Int -> Const Int (Map CodeLocation Int))
-> VM -> Const Int VM
Lens' VM (Map CodeLocation Int)
iterations ((Map CodeLocation Int -> Const Int (Map CodeLocation Int))
 -> VM -> Const Int VM)
-> ((Int -> Const Int Int)
    -> Map CodeLocation Int -> Const Int (Map CodeLocation Int))
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map CodeLocation Int)
-> Lens'
     (Map CodeLocation Int) (Maybe (IxValue (Map CodeLocation Int)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation Int)
codeloc ((Maybe Int -> Const Int (Maybe Int))
 -> Map CodeLocation Int -> Const Int (Map CodeLocation Int))
-> ((Int -> Const Int Int) -> Maybe Int -> Const Int (Maybe Int))
-> (Int -> Const Int Int)
-> Map CodeLocation Int
-> Const Int (Map CodeLocation Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Iso' (Maybe Int) Int
forall a. Eq a => a -> Iso' (Maybe a) a
non Int
0)

  -- If we are backstepping, the result of this query should be cached
  -- already. So we first check the cache to see if the result is known
  Getting (Maybe Bool) VM (Maybe Bool)
-> StateT VM Identity (Maybe Bool)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Cache -> Const (Maybe Bool) Cache) -> VM -> Const (Maybe Bool) VM
Lens' VM Cache
cache ((Cache -> Const (Maybe Bool) Cache)
 -> VM -> Const (Maybe Bool) VM)
-> ((Maybe Bool -> Const (Maybe Bool) (Maybe Bool))
    -> Cache -> Const (Maybe Bool) Cache)
-> Getting (Maybe Bool) VM (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (CodeLocation, Int) Bool
 -> Const (Maybe Bool) (Map (CodeLocation, Int) Bool))
-> Cache -> Const (Maybe Bool) Cache
Lens' Cache (Map (CodeLocation, Int) Bool)
path ((Map (CodeLocation, Int) Bool
  -> Const (Maybe Bool) (Map (CodeLocation, Int) Bool))
 -> Cache -> Const (Maybe Bool) Cache)
-> ((Maybe Bool -> Const (Maybe Bool) (Maybe Bool))
    -> Map (CodeLocation, Int) Bool
    -> Const (Maybe Bool) (Map (CodeLocation, Int) Bool))
-> (Maybe Bool -> Const (Maybe Bool) (Maybe Bool))
-> Cache
-> Const (Maybe Bool) Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (CodeLocation, Int) Bool)
-> Lens'
     (Map (CodeLocation, Int) Bool)
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (CodeLocation
codeloc, Int
iteration)) StateT VM Identity (Maybe Bool) -> (Maybe Bool -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
     -- If the query has been done already, select path or select the only available
     Just Bool
w -> BranchCondition -> EVM ()
choosePath (Bool -> BranchCondition
Case Bool
w)
     -- If this is a new query, run the query, cache the result
     -- increment the iterations and select appropriate path
     Maybe Bool
Nothing -> do [(SBool, Whiff)]
pathconds <- Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
-> StateT VM Identity [(SBool, Whiff)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(SBool, Whiff)] VM [(SBool, Whiff)]
Lens' VM [(SBool, Whiff)]
constraints
                   ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (Query -> Maybe VMResult) -> Query -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> (Query -> VMResult) -> Query -> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure (Error -> VMResult) -> (Query -> Error) -> Query -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query (Query -> EVM ()) -> Query -> EVM ()
forall a b. (a -> b) -> a -> b
$ SBool -> [SBool] -> (BranchCondition -> EVM ()) -> Query
PleaseAskSMT
                     SBool
condition' ((SBool, Whiff) -> SBool
forall a b. (a, b) -> a
fst ((SBool, Whiff) -> SBool) -> [(SBool, Whiff)] -> [SBool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SBool, Whiff)]
pathconds) BranchCondition -> EVM ()
choosePath

   where condition' :: SBool
condition' = SBool -> Whiff -> SBool
simplifyCondition SBool
condition Whiff
whiff
     -- Only one path is possible

         choosePath :: BranchCondition -> EVM ()
         choosePath :: BranchCondition -> EVM ()
choosePath (Case Bool
v) = do ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result Maybe VMResult
forall a. Maybe a
Nothing
                                  (([(SBool, Whiff)] -> Identity [(SBool, Whiff)])
 -> VM -> Identity VM)
-> (SBool, Whiff) -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo ([(SBool, Whiff)] -> Identity [(SBool, Whiff)])
-> VM -> Identity VM
Lens' VM [(SBool, Whiff)]
constraints ((SBool, Whiff) -> EVM ()) -> (SBool, Whiff) -> EVM ()
forall a b. (a -> b) -> a -> b
$ if Bool
v then (SBool
condition', Whiff
whiff) else (SBool -> SBool
sNot SBool
condition', Whiff -> Whiff
IsZero Whiff
whiff)
                                  Int
iteration <- Getting Int VM Int -> StateT VM Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map CodeLocation Int -> Const Int (Map CodeLocation Int))
-> VM -> Const Int VM
Lens' VM (Map CodeLocation Int)
iterations ((Map CodeLocation Int -> Const Int (Map CodeLocation Int))
 -> VM -> Const Int VM)
-> ((Int -> Const Int Int)
    -> Map CodeLocation Int -> Const Int (Map CodeLocation Int))
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map CodeLocation Int)
-> Lens'
     (Map CodeLocation Int) (Maybe (IxValue (Map CodeLocation Int)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation Int)
codeloc ((Maybe Int -> Const Int (Maybe Int))
 -> Map CodeLocation Int -> Const Int (Map CodeLocation Int))
-> ((Int -> Const Int Int) -> Maybe Int -> Const Int (Maybe Int))
-> (Int -> Const Int Int)
-> Map CodeLocation Int
-> Const Int (Map CodeLocation Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Iso' (Maybe Int) Int
forall a. Eq a => a -> Iso' (Maybe a) a
non Int
0)
                                  ASetter VM VM (Maybe Bool) (Maybe Bool) -> Maybe Bool -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Maybe Bool -> Identity (Maybe Bool))
    -> Cache -> Identity Cache)
-> ASetter VM VM (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (CodeLocation, Int) Bool
 -> Identity (Map (CodeLocation, Int) Bool))
-> Cache -> Identity Cache
Lens' Cache (Map (CodeLocation, Int) Bool)
path ((Map (CodeLocation, Int) Bool
  -> Identity (Map (CodeLocation, Int) Bool))
 -> Cache -> Identity Cache)
-> ((Maybe Bool -> Identity (Maybe Bool))
    -> Map (CodeLocation, Int) Bool
    -> Identity (Map (CodeLocation, Int) Bool))
-> (Maybe Bool -> Identity (Maybe Bool))
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (CodeLocation, Int) Bool)
-> Lens'
     (Map (CodeLocation, Int) Bool)
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (CodeLocation
codeloc, Int
iteration)) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
v)
                                  ASetter VM VM (Maybe Int) (Maybe Int) -> Maybe Int -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Map CodeLocation Int -> Identity (Map CodeLocation Int))
-> VM -> Identity VM
Lens' VM (Map CodeLocation Int)
iterations ((Map CodeLocation Int -> Identity (Map CodeLocation Int))
 -> VM -> Identity VM)
-> ((Maybe Int -> Identity (Maybe Int))
    -> Map CodeLocation Int -> Identity (Map CodeLocation Int))
-> ASetter VM VM (Maybe Int) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map CodeLocation Int)
-> Lens'
     (Map CodeLocation Int) (Maybe (IxValue (Map CodeLocation Int)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation Int)
codeloc) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
iteration Int -> Int -> Int
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 = ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> ((Bool -> EVM ()) -> Maybe VMResult)
-> (Bool -> EVM ())
-> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> ((Bool -> EVM ()) -> VMResult)
-> (Bool -> EVM ())
-> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure (Error -> VMResult)
-> ((Bool -> EVM ()) -> Error) -> (Bool -> EVM ()) -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choose -> Error
Choose (Choose -> Error)
-> ((Bool -> EVM ()) -> Choose) -> (Bool -> EVM ()) -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Whiff -> (Bool -> EVM ()) -> Choose
PleaseChoosePath Whiff
whiff ((Bool -> EVM ()) -> EVM ()) -> (Bool -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ BranchCondition -> EVM ()
choosePath (BranchCondition -> EVM ())
-> (Bool -> BranchCondition) -> Bool -> EVM ()
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 =
  Getting (Maybe Contract) VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) StateT VM Identity (Maybe Contract)
-> (Maybe Contract -> EVM ()) -> EVM ()
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 ->
      Getting (Maybe Contract) VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Cache -> Const (Maybe Contract) Cache)
-> VM -> Const (Maybe Contract) VM
Lens' VM Cache
cache ((Cache -> Const (Maybe Contract) Cache)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Cache -> Const (Maybe Contract) Cache)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Cache -> Const (Maybe Contract) Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Cache -> Const (Maybe Contract) Cache)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Cache
-> Const (Maybe Contract) Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) StateT VM Identity (Maybe Contract)
-> (Maybe Contract -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Contract
c -> do
          ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
c)
          Contract -> EVM ()
continue Contract
c
        Maybe Contract
Nothing -> do
          StorageModel
model <- Getting StorageModel VM StorageModel
-> StateT VM Identity StorageModel
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const StorageModel Env) -> VM -> Const StorageModel VM
Lens' VM Env
env ((Env -> Const StorageModel Env) -> VM -> Const StorageModel VM)
-> ((StorageModel -> Const StorageModel StorageModel)
    -> Env -> Const StorageModel Env)
-> Getting StorageModel VM StorageModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageModel -> Const StorageModel StorageModel)
-> Env -> Const StorageModel Env
Lens' Env StorageModel
storageModel)
          ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (Error -> Maybe VMResult) -> Error -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> (Error -> VMResult) -> Error -> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure (Error -> EVM ()) -> Error -> EVM ()
forall a b. (a -> b) -> a -> b
$ Query -> Error
Query (Query -> Error) -> Query -> Error
forall a b. (a -> b) -> a -> b
$
            Addr -> StorageModel -> (Contract -> EVM ()) -> Query
PleaseFetchContract Addr
addr StorageModel
model
              (\Contract
c -> do ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Cache -> Identity Cache)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Cache -> Identity Cache)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
c)
                        ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Maybe Contract -> Identity (Maybe Contract))
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
c)
                        ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result Maybe VMResult
forall a. Maybe a
Nothing
                        Contract -> EVM ()
tryContinue Contract
c)
  where
    tryContinue :: Contract -> EVM ()
tryContinue Contract
c =
      if (Getting Bool Contract Bool -> Contract -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Contract Bool
Lens' Contract Bool
external Contract
c) Bool -> Bool -> Bool
&& (Contract -> Bool
accountEmpty Contract
c)
        then Error -> EVM ()
vmError (Error -> EVM ()) -> (Addr -> Error) -> Addr -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Error
NoSuchContract (Addr -> EVM ()) -> Addr -> EVM ()
forall a b. (a -> b) -> a -> b
$ Addr
addr
        else Contract -> EVM ()
continue Contract
c

readStorage :: Storage -> SymWord -> Maybe (SymWord)
readStorage :: Storage -> SymWord -> Maybe SymWord
readStorage (Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
s) (S Whiff
w SWord 256
loc) = SymWord -> Maybe SymWord
forall a. a -> Maybe a
Just (SymWord -> Maybe SymWord) -> SymWord -> Maybe SymWord
forall a b. (a -> b) -> a -> b
$ Whiff -> SWord 256 -> SymWord
S (Whiff -> SArray (WordN 256) (WordN 256) -> Whiff
FromStorage Whiff
w SArray (WordN 256) (WordN 256)
s) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SArray (WordN 256) (WordN 256) -> SWord 256 -> SWord 256
forall (array :: * -> * -> *) a b.
SymArray array =>
array a b -> SBV a -> SBV b
readArray SArray (WordN 256) (WordN 256)
s SWord 256
loc
readStorage (Concrete Map Word SymWord
s) SymWord
loc = Word -> Map Word SymWord -> Maybe SymWord
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SymWord -> Word
forceLit SymWord
loc) Map Word SymWord
s

writeStorage :: SymWord -> SymWord -> Storage -> Storage
writeStorage :: SymWord -> SymWord -> Storage -> Storage
writeStorage k :: SymWord
k@(S Whiff
_ SWord 256
loc) v :: SymWord
v@(S Whiff
_ SWord 256
val) (Symbolic [(SymWord, SymWord)]
xs SArray (WordN 256) (WordN 256)
s) = [(SymWord, SymWord)] -> SArray (WordN 256) (WordN 256) -> Storage
Symbolic ((SymWord
k,SymWord
v)(SymWord, SymWord) -> [(SymWord, SymWord)] -> [(SymWord, SymWord)]
forall a. a -> [a] -> [a]
:[(SymWord, SymWord)]
xs) (SArray (WordN 256) (WordN 256)
-> SWord 256 -> SWord 256 -> SArray (WordN 256) (WordN 256)
forall (array :: * -> * -> *) b a.
(SymArray array, SymVal b) =>
array a b -> SBV a -> SBV b -> array a b
writeArray SArray (WordN 256) (WordN 256)
s SWord 256
loc SWord 256
val)
writeStorage SymWord
loc SymWord
val (Concrete Map Word SymWord
s) = Map Word SymWord -> Storage
Concrete (Word -> SymWord -> Map Word SymWord -> Map Word SymWord
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SymWord -> Word
forceLit SymWord
loc) SymWord
val Map Word SymWord
s)

accessStorage
  :: Addr                -- ^ Contract address
  -> SymWord             -- ^ Storage slot key
  -> (SymWord -> EVM ()) -- ^ Continuation
  -> EVM ()
accessStorage :: Addr -> SymWord -> (SymWord -> EVM ()) -> EVM ()
accessStorage Addr
addr SymWord
slot SymWord -> EVM ()
continue =
  Getting (Maybe Contract) VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) StateT VM Identity (Maybe Contract)
-> (Maybe Contract -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Contract
c ->
      case Storage -> SymWord -> Maybe SymWord
readStorage (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
c) SymWord
slot of
        -- Notice that if storage is symbolic, we always continue straight away
        Just SymWord
x ->
          SymWord -> EVM ()
continue SymWord
x
        Maybe SymWord
Nothing ->
          if Getting Bool Contract Bool -> Contract -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Contract Bool
Lens' Contract Bool
external Contract
c
          then
            -- check if the slot is cached
            Getting (Maybe Contract) VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Cache -> Const (Maybe Contract) Cache)
-> VM -> Const (Maybe Contract) VM
Lens' VM Cache
cache ((Cache -> Const (Maybe Contract) Cache)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Cache -> Const (Maybe Contract) Cache)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Cache -> Const (Maybe Contract) Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Cache -> Const (Maybe Contract) Cache)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Cache
-> Const (Maybe Contract) Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) StateT VM Identity (Maybe Contract)
-> (Maybe Contract -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe Contract
Nothing -> EVM ()
mkQuery
              Just Contract
cachedContract ->
                EVM () -> (SymWord -> EVM ()) -> Maybe SymWord -> EVM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EVM ()
mkQuery SymWord -> EVM ()
continue (Storage -> SymWord -> Maybe SymWord
readStorage (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
cachedContract) SymWord
slot)
          else do
            ASetter VM VM Storage Storage -> (Storage -> Storage) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Env -> Identity Env)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Storage -> Identity Storage)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ASetter Contract Contract Storage Storage
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage) (SymWord -> SymWord -> Storage -> Storage
writeStorage SymWord
slot SymWord
0)
            SymWord -> EVM ()
continue SymWord
0
    Maybe Contract
Nothing ->
      Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ ->
        Addr -> SymWord -> (SymWord -> EVM ()) -> EVM ()
accessStorage Addr
addr SymWord
slot SymWord -> EVM ()
continue
  where
      mkQuery :: EVM ()
mkQuery = ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (Query -> Maybe VMResult) -> Query -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> (Query -> VMResult) -> Query -> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure (Error -> VMResult) -> (Query -> Error) -> Query -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query (Query -> EVM ()) -> Query -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  Addr -> Word -> (Word -> EVM ()) -> Query
PleaseFetchSlot Addr
addr (SymWord -> Word
forceLit SymWord
slot)
                    (\(Word -> SymWord
litWord -> SymWord
x) -> do
                        ASetter VM VM Storage Storage -> (Storage -> Storage) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Cache -> Identity Cache)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Cache -> Identity Cache)
-> ((Storage -> Identity Storage)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ASetter Contract Contract Storage Storage
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage) (SymWord -> SymWord -> Storage -> Storage
writeStorage SymWord
slot SymWord
x)
                        ASetter VM VM Storage Storage -> (Storage -> Storage) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Env -> Identity Env)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Storage -> Identity Storage)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ASetter Contract Contract Storage Storage
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage) (SymWord -> SymWord -> Storage -> Storage
writeStorage SymWord
slot SymWord
x)
                        ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result Maybe VMResult
forall a. Maybe a
Nothing
                        SymWord -> EVM ()
continue SymWord
x)

accountExists :: Addr -> VM -> Bool
accountExists :: Addr -> VM -> Bool
accountExists Addr
addr VM
vm =
  case Getting (Maybe Contract) VM (Maybe Contract)
-> VM -> Maybe Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) VM
vm 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 Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
c of
    RuntimeCode Buffer
b -> Buffer -> Int
len Buffer
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    ContractCode
_ -> Bool
False
  Bool -> Bool -> Bool
&& (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
c Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0)
  Bool -> Bool -> Bool
&& (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
c Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0)

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

  Getting (Maybe VMResult) VM (Maybe VMResult)
-> StateT VM Identity (Maybe VMResult)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe VMResult) VM (Maybe VMResult)
Lens' VM (Maybe VMResult)
result StateT VM Identity (Maybe VMResult)
-> (Maybe VMResult -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe VMResult
Nothing ->
      String -> EVM ()
forall a. HasCallStack => String -> a
error String
"Finalising an unfinished tx."
    Just (VMFailure (Revert ByteString
_)) -> do
      EVM ()
revertContracts
      EVM ()
revertSubstate
    Just (VMFailure Error
_) -> do
      -- burn remaining gas
      ((Word -> Identity Word) -> VM -> Identity VM) -> Word -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> FrameState -> Identity FrameState)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> FrameState -> Identity FrameState
Lens' FrameState Word
gas) Word
0
      EVM ()
revertContracts
      EVM ()
revertSubstate
    Just (VMSuccess Buffer
output) -> do
      -- deposit the code from a creation tx
      Bool
creation <- Getting Bool VM Bool -> EVM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const Bool TxState) -> VM -> Const Bool VM
Lens' VM TxState
tx ((TxState -> Const Bool TxState) -> VM -> Const Bool VM)
-> ((Bool -> Const Bool Bool) -> TxState -> Const Bool TxState)
-> Getting Bool VM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> TxState -> Const Bool TxState
Lens' TxState Bool
isCreate)
      Addr
createe  <- Getting Addr VM Addr -> StateT VM Identity Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract)
      Bool
createeExists <- (Addr -> Map Addr Contract -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Addr
createe) (Map Addr Contract -> Bool)
-> StateT VM Identity (Map Addr Contract) -> EVM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Map Addr Contract) VM (Map Addr Contract)
-> StateT VM Identity (Map Addr Contract)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts)

      Bool -> EVM () -> EVM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
creation Bool -> Bool -> Bool
&& Bool
createeExists) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ Addr -> ContractCode -> EVM ()
replaceCode Addr
createe (Buffer -> ContractCode
RuntimeCode Buffer
output)

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

  let
    gasUsed :: Word
gasUsed      = Word
gasLimit Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
gasRemaining
    cappedRefund :: Word
cappedRefund = Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (Word -> Word -> Word
forall a. Integral a => a -> a -> a
quot Word
gasUsed Word
2) (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
sumRefunds)
    originPay :: Word
originPay    = (Word
gasRemaining Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
cappedRefund) Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
gasPrice
    minerPay :: Word
minerPay     = Word
gasPrice Word -> Word -> Word
forall a. Num a => a -> a -> a
* (Word
gasUsed Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
cappedRefund)

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

  -- pay out the block reward, recreating the miner if necessary
  Getting (First Contract) VM Contract
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse ((Env -> Const (First Contract) Env)
-> VM -> Const (First Contract) VM
Lens' VM Env
env ((Env -> Const (First Contract) Env)
 -> VM -> Const (First Contract) VM)
-> ((Contract -> Const (First Contract) Contract)
    -> Env -> Const (First Contract) Env)
-> Getting (First Contract) VM Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (First Contract) (Map Addr Contract))
-> Env -> Const (First Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (First Contract) (Map Addr Contract))
 -> Env -> Const (First Contract) Env)
-> Getting (First Contract) (Map Addr Contract) Contract
-> (Contract -> Const (First Contract) Contract)
-> Env
-> Const (First Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
miner) StateT VM Identity (Maybe Contract)
-> (Maybe Contract -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Contract
Nothing -> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts)
      (Addr -> Contract -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Addr
miner (ContractCode -> Contract
initialContract (Buffer -> ContractCode
EVM.RuntimeCode Buffer
forall a. Monoid a => a
mempty)))
    Just Contract
_  -> EVM ()
forall (m :: * -> *). Monad m => m ()
noop
  ASetter VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts)
    ((Contract -> Contract)
-> Addr -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Word) -> Contract -> Contract
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
balance (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
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 <- Getting [Addr] VM [Addr] -> StateT VM Identity [Addr]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM
Lens' VM TxState
tx ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM)
-> (([Addr] -> Const [Addr] [Addr])
    -> TxState -> Const [Addr] TxState)
-> Getting [Addr] VM [Addr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const [Addr] SubState)
-> TxState -> Const [Addr] TxState
Lens' TxState SubState
substate ((SubState -> Const [Addr] SubState)
 -> TxState -> Const [Addr] TxState)
-> (([Addr] -> Const [Addr] [Addr])
    -> SubState -> Const [Addr] SubState)
-> ([Addr] -> Const [Addr] [Addr])
-> TxState
-> Const [Addr] TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Addr] -> Const [Addr] [Addr])
-> SubState -> Const [Addr] SubState
Lens' SubState [Addr]
selfdestructs)
  ASetter VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts)
    ((Addr -> Contract -> Bool)
-> Map Addr Contract -> Map Addr Contract
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Addr
k Contract
_ -> (Addr -> [Addr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Addr
k [Addr]
destroyedAddresses)))
  -- then, clear any remaining empty and touched addresses
  [Addr]
touchedAddresses <- Getting [Addr] VM [Addr] -> StateT VM Identity [Addr]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM
Lens' VM TxState
tx ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM)
-> (([Addr] -> Const [Addr] [Addr])
    -> TxState -> Const [Addr] TxState)
-> Getting [Addr] VM [Addr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const [Addr] SubState)
-> TxState -> Const [Addr] TxState
Lens' TxState SubState
substate ((SubState -> Const [Addr] SubState)
 -> TxState -> Const [Addr] TxState)
-> (([Addr] -> Const [Addr] [Addr])
    -> SubState -> Const [Addr] SubState)
-> ([Addr] -> Const [Addr] [Addr])
-> TxState
-> Const [Addr] TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Addr] -> Const [Addr] [Addr])
-> SubState -> Const [Addr] SubState
Lens' SubState [Addr]
touchedAccounts)
  ASetter VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> Env -> Identity Env)
-> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts)
    ((Addr -> Contract -> Bool)
-> Map Addr Contract -> Map Addr Contract
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
      (\Addr
k Contract
a -> Bool -> Bool
not ((Addr -> [Addr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Addr
k [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 =
  Getting (First ContractCode) VM ContractCode
-> StateT VM Identity (Maybe ContractCode)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse ((Env -> Const (First ContractCode) Env)
-> VM -> Const (First ContractCode) VM
Lens' VM Env
env ((Env -> Const (First ContractCode) Env)
 -> VM -> Const (First ContractCode) VM)
-> ((ContractCode -> Const (First ContractCode) ContractCode)
    -> Env -> Const (First ContractCode) Env)
-> Getting (First ContractCode) VM ContractCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (First ContractCode) (Map Addr Contract))
-> Env -> Const (First ContractCode) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract
  -> Const (First ContractCode) (Map Addr Contract))
 -> Env -> Const (First ContractCode) Env)
-> ((ContractCode -> Const (First ContractCode) ContractCode)
    -> Map Addr Contract
    -> Const (First ContractCode) (Map Addr Contract))
-> (ContractCode -> Const (First ContractCode) ContractCode)
-> Env
-> Const (First ContractCode) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
target ((Contract -> Const (First ContractCode) Contract)
 -> Map Addr Contract
 -> Const (First ContractCode) (Map Addr Contract))
-> ((ContractCode -> Const (First ContractCode) ContractCode)
    -> Contract -> Const (First ContractCode) Contract)
-> (ContractCode -> Const (First ContractCode) ContractCode)
-> Map Addr Contract
-> Const (First ContractCode) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractCode -> Const (First ContractCode) ContractCode)
-> Contract -> Const (First ContractCode) Contract
Lens' Contract ContractCode
contractcode) StateT VM Identity (Maybe ContractCode)
-> (Maybe ContractCode -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe ContractCode
Nothing ->
        String -> EVM ()
forall a. HasCallStack => String -> a
error String
"Call target doesn't exist"
      Just (InitCode Buffer
targetCode) -> do
        ASetter VM VM Addr Addr -> Addr -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ASetter FrameState FrameState Addr Addr
-> ASetter VM VM Addr Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
contract) Addr
target
        ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
code)     Buffer
targetCode
        ASetter VM VM Addr Addr -> Addr -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ASetter FrameState FrameState Addr Addr
-> ASetter VM VM Addr Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
codeContract) Addr
target
      Just (RuntimeCode Buffer
targetCode) -> do
        ASetter VM VM Addr Addr -> Addr -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ASetter FrameState FrameState Addr Addr
-> ASetter VM VM Addr Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
contract) Addr
target
        ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
code)     Buffer
targetCode
        ASetter VM VM Addr Addr -> Addr -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ASetter FrameState FrameState Addr Addr
-> ASetter VM VM Addr Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
codeContract) Addr
target

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

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

-- | Burn gas, failing if insufficient gas is available
-- We use the `Integer` type to avoid overflows in intermediate
-- calculations and throw if the value won't fit into a uint64
burn :: Integer -> EVM () -> EVM ()
burn :: Integer -> EVM () -> EVM ()
burn Integer
n' EVM ()
continue =
  if Integer
n' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (Integer
2 :: Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
64 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
  then Error -> EVM ()
vmError Error
IllegalOverflow
  else do
    let n :: Word
n = Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
n'
    Word
available <- Getting Word VM Word -> StateT VM Identity Word
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas)
    if Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
available
      then do
        (FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> FrameState -> Identity FrameState)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> FrameState -> Identity FrameState
Lens' FrameState Word
gas ((Word -> Identity Word) -> VM -> Identity VM) -> Word -> EVM ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= Word
n
        (Word -> Identity Word) -> VM -> Identity VM
Lens' VM Word
burned ((Word -> Identity Word) -> VM -> Identity VM) -> Word -> EVM ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Word
n
        EVM ()
continue
      else
        Error -> EVM ()
vmError (Word -> Word -> Error
OutOfGas Word
available Word
n)

forceConcreteAddr :: SAddr -> (Addr -> EVM ()) -> EVM ()
forceConcreteAddr :: SAddr -> (Addr -> EVM ()) -> EVM ()
forceConcreteAddr SAddr
n Addr -> EVM ()
continue = case SAddr -> Maybe Addr
maybeLitAddr SAddr
n of
  Maybe Addr
Nothing -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
  Just Addr
c -> Addr -> EVM ()
continue Addr
c

forceConcrete :: SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete :: SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
n Word -> EVM ()
continue = case SymWord -> Maybe Word
maybeLitWord SymWord
n of
  Maybe Word
Nothing -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
  Just Word
c -> Word -> EVM ()
continue Word
c

forceConcrete2 :: (SymWord, SymWord) -> ((Word, Word) -> EVM ()) -> EVM ()
forceConcrete2 :: (SymWord, SymWord) -> ((Word, Word) -> EVM ()) -> EVM ()
forceConcrete2 (SymWord
n,SymWord
m) (Word, Word) -> EVM ()
continue = case (SymWord -> Maybe Word
maybeLitWord SymWord
n, SymWord -> Maybe Word
maybeLitWord SymWord
m) of
  (Just Word
c, Just Word
d) -> (Word, Word) -> EVM ()
continue (Word
c, Word
d)
  (Maybe Word, Maybe Word)
_ -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg

forceConcrete3 :: (SymWord, SymWord, SymWord) -> ((Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete3 :: (SymWord, SymWord, SymWord)
-> ((Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete3 (SymWord
k,SymWord
n,SymWord
m) (Word, Word, Word) -> EVM ()
continue = case (SymWord -> Maybe Word
maybeLitWord SymWord
k, SymWord -> Maybe Word
maybeLitWord SymWord
n, SymWord -> Maybe Word
maybeLitWord SymWord
m) of
  (Just Word
c, Just Word
d, Just Word
f) -> (Word, Word, Word) -> EVM ()
continue (Word
c, Word
d, Word
f)
  (Maybe Word, Maybe Word, Maybe Word)
_ -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg

forceConcrete4 :: (SymWord, SymWord, SymWord, SymWord) -> ((Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete4 :: (SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete4 (SymWord
k,SymWord
l,SymWord
n,SymWord
m) (Word, Word, Word, Word) -> EVM ()
continue = case (SymWord -> Maybe Word
maybeLitWord SymWord
k, SymWord -> Maybe Word
maybeLitWord SymWord
l, SymWord -> Maybe Word
maybeLitWord SymWord
n, SymWord -> Maybe Word
maybeLitWord SymWord
m) of
  (Just Word
b, Just Word
c, Just Word
d, Just Word
f) -> (Word, Word, Word, Word) -> EVM ()
continue (Word
b, Word
c, Word
d, Word
f)
  (Maybe Word, Maybe Word, Maybe Word, Maybe Word)
_ -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg

forceConcrete5 :: (SymWord, SymWord, SymWord, SymWord, SymWord) -> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete5 :: (SymWord, SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete5 (SymWord
k,SymWord
l,SymWord
m,SymWord
n,SymWord
o) (Word, Word, Word, Word, Word) -> EVM ()
continue = case (SymWord -> Maybe Word
maybeLitWord SymWord
k, SymWord -> Maybe Word
maybeLitWord SymWord
l, SymWord -> Maybe Word
maybeLitWord SymWord
m, SymWord -> Maybe Word
maybeLitWord SymWord
n, SymWord -> Maybe Word
maybeLitWord SymWord
o) of
  (Just Word
a, Just Word
b, Just Word
c, Just Word
d, Just Word
e) -> (Word, Word, Word, Word, Word) -> EVM ()
continue (Word
a, Word
b, Word
c, Word
d, Word
e)
  (Maybe Word, Maybe Word, Maybe Word, Maybe Word, Maybe Word)
_ -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg

forceConcrete6 :: (SymWord, SymWord, SymWord, SymWord, SymWord, SymWord) -> ((Word, Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete6 :: (SymWord, SymWord, SymWord, SymWord, SymWord, SymWord)
-> ((Word, Word, Word, Word, Word, Word) -> EVM ()) -> EVM ()
forceConcrete6 (SymWord
k,SymWord
l,SymWord
m,SymWord
n,SymWord
o,SymWord
p) (Word, Word, Word, Word, Word, Word) -> EVM ()
continue = case (SymWord -> Maybe Word
maybeLitWord SymWord
k, SymWord -> Maybe Word
maybeLitWord SymWord
l, SymWord -> Maybe Word
maybeLitWord SymWord
m, SymWord -> Maybe Word
maybeLitWord SymWord
n, SymWord -> Maybe Word
maybeLitWord SymWord
o, SymWord -> Maybe Word
maybeLitWord SymWord
p) of
  (Just Word
a, Just Word
b, Just Word
c, Just Word
d, Just Word
e, Just Word
f) -> (Word, Word, Word, Word, Word, Word) -> EVM ()
continue (Word
a, Word
b, Word
c, Word
d, Word
e, Word
f)
  (Maybe Word, Maybe Word, Maybe Word, Maybe Word, Maybe Word,
 Maybe Word)
_ -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg

forceConcreteBuffer :: Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer :: Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer (SymbolicBuffer [SWord 8]
b) ByteString -> EVM ()
continue = case [SWord 8] -> Maybe ByteString
maybeLitBytes [SWord 8]
b of
  Maybe ByteString
Nothing -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
  Just ByteString
bs -> ByteString -> EVM ()
continue ByteString
bs
forceConcreteBuffer (ConcreteBuffer ByteString
b) ByteString -> EVM ()
continue = ByteString -> EVM ()
continue ByteString
b

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

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

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

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

accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn Addr
x EVM ()
cont = do
  FeeSchedule {Integer
g_access_list_storage_key :: Integer
g_access_list_address :: Integer
g_warm_storage_read :: Integer
g_cold_account_access :: Integer
g_cold_sload :: Integer
r_block :: Integer
g_fround :: Integer
g_pairing_base :: Integer
g_pairing_point :: Integer
g_ecmul :: Integer
g_ecadd :: Integer
g_quaddivisor :: Integer
g_extcodehash :: Integer
g_blockhash :: Integer
g_copy :: Integer
g_sha3word :: Integer
g_sha3 :: Integer
g_logtopic :: Integer
g_logdata :: Integer
g_log :: Integer
g_transaction :: Integer
g_txdatanonzero :: Integer
g_txdatazero :: Integer
g_txcreate :: Integer
g_memory :: Integer
g_expbyte :: Integer
g_exp :: Integer
g_newaccount :: Integer
g_callstipend :: Integer
g_callvalue :: Integer
g_call :: Integer
g_codedeposit :: Integer
g_create :: Integer
r_selfdestruct :: Integer
g_selfdestruct_newaccount :: Integer
g_selfdestruct :: Integer
r_sclear :: Integer
g_sreset :: Integer
g_sset :: Integer
g_jumpdest :: Integer
g_sload :: Integer
g_balance :: Integer
g_extcode :: Integer
g_high :: Integer
g_mid :: Integer
g_low :: Integer
g_verylow :: Integer
g_base :: Integer
g_zero :: Integer
g_access_list_storage_key :: forall n. FeeSchedule n -> n
g_access_list_address :: forall n. FeeSchedule n -> n
g_warm_storage_read :: forall n. FeeSchedule n -> n
g_cold_account_access :: forall n. FeeSchedule n -> n
g_cold_sload :: forall n. FeeSchedule n -> n
r_block :: forall n. FeeSchedule n -> n
g_fround :: forall n. FeeSchedule n -> n
g_pairing_base :: forall n. FeeSchedule n -> n
g_pairing_point :: forall n. FeeSchedule n -> n
g_ecmul :: forall n. FeeSchedule n -> n
g_ecadd :: forall n. FeeSchedule n -> n
g_quaddivisor :: forall n. FeeSchedule n -> n
g_extcodehash :: forall n. FeeSchedule n -> n
g_blockhash :: forall n. FeeSchedule n -> n
g_copy :: forall n. FeeSchedule n -> n
g_sha3word :: forall n. FeeSchedule n -> n
g_sha3 :: forall n. FeeSchedule n -> n
g_logtopic :: forall n. FeeSchedule n -> n
g_logdata :: forall n. FeeSchedule n -> n
g_log :: forall n. FeeSchedule n -> n
g_transaction :: forall n. FeeSchedule n -> n
g_txdatanonzero :: forall n. FeeSchedule n -> n
g_txdatazero :: forall n. FeeSchedule n -> n
g_txcreate :: forall n. FeeSchedule n -> n
g_memory :: forall n. FeeSchedule n -> n
g_expbyte :: forall n. FeeSchedule n -> n
g_exp :: forall n. FeeSchedule n -> n
g_newaccount :: forall n. FeeSchedule n -> n
g_callstipend :: forall n. FeeSchedule n -> n
g_callvalue :: forall n. FeeSchedule n -> n
g_call :: forall n. FeeSchedule n -> n
g_codedeposit :: forall n. FeeSchedule n -> n
g_create :: forall n. FeeSchedule n -> n
r_selfdestruct :: forall n. FeeSchedule n -> n
g_selfdestruct_newaccount :: forall n. FeeSchedule n -> n
g_selfdestruct :: forall n. FeeSchedule n -> n
r_sclear :: forall n. FeeSchedule n -> n
g_sreset :: forall n. FeeSchedule n -> n
g_sset :: forall n. FeeSchedule n -> n
g_jumpdest :: forall n. FeeSchedule n -> n
g_sload :: forall n. FeeSchedule n -> n
g_balance :: forall n. FeeSchedule n -> n
g_extcode :: forall n. FeeSchedule n -> n
g_high :: forall n. FeeSchedule n -> n
g_mid :: forall n. FeeSchedule n -> n
g_low :: forall n. FeeSchedule n -> n
g_verylow :: forall n. FeeSchedule n -> n
g_base :: forall n. FeeSchedule n -> n
g_zero :: forall n. FeeSchedule n -> n
..} <- Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
-> StateT VM Identity (FeeSchedule Integer)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ( (Block -> Const (FeeSchedule Integer) Block)
-> VM -> Const (FeeSchedule Integer) VM
Lens' VM Block
block ((Block -> Const (FeeSchedule Integer) Block)
 -> VM -> Const (FeeSchedule Integer) VM)
-> ((FeeSchedule Integer
     -> Const (FeeSchedule Integer) (FeeSchedule Integer))
    -> Block -> Const (FeeSchedule Integer) Block)
-> Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FeeSchedule Integer
 -> Const (FeeSchedule Integer) (FeeSchedule Integer))
-> Block -> Const (FeeSchedule Integer) Block
Lens' Block (FeeSchedule Integer)
schedule )
  Bool
acc <- Addr -> EVM Bool
accessAccountForGas Addr
x
  let cost :: Integer
cost = if Bool
acc then Integer
g_warm_storage_read else Integer
g_cold_account_access
  Integer -> EVM () -> EVM ()
burn Integer
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 <- Getting (Set Addr) VM (Set Addr) -> StateT VM Identity (Set Addr)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const (Set Addr) TxState) -> VM -> Const (Set Addr) VM
Lens' VM TxState
tx ((TxState -> Const (Set Addr) TxState)
 -> VM -> Const (Set Addr) VM)
-> ((Set Addr -> Const (Set Addr) (Set Addr))
    -> TxState -> Const (Set Addr) TxState)
-> Getting (Set Addr) VM (Set Addr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const (Set Addr) SubState)
-> TxState -> Const (Set Addr) TxState
Lens' TxState SubState
substate ((SubState -> Const (Set Addr) SubState)
 -> TxState -> Const (Set Addr) TxState)
-> ((Set Addr -> Const (Set Addr) (Set Addr))
    -> SubState -> Const (Set Addr) SubState)
-> (Set Addr -> Const (Set Addr) (Set Addr))
-> TxState
-> Const (Set Addr) TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Addr -> Const (Set Addr) (Set Addr))
-> SubState -> Const (Set Addr) SubState
Lens' SubState (Set Addr)
accessedAddresses)
  let accessed :: Bool
accessed = Addr -> Set Addr -> Bool
forall a. Ord a => a -> Set a -> Bool
member Addr
addr Set Addr
accessedAddrs
  ASetter VM VM (Set Addr) (Set Addr) -> Set Addr -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((TxState -> Identity TxState) -> VM -> Identity VM
Lens' VM TxState
tx ((TxState -> Identity TxState) -> VM -> Identity VM)
-> ((Set Addr -> Identity (Set Addr))
    -> TxState -> Identity TxState)
-> ASetter VM VM (Set Addr) (Set Addr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Identity SubState) -> TxState -> Identity TxState
Lens' TxState SubState
substate ((SubState -> Identity SubState) -> TxState -> Identity TxState)
-> ((Set Addr -> Identity (Set Addr))
    -> SubState -> Identity SubState)
-> (Set Addr -> Identity (Set Addr))
-> TxState
-> Identity TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Addr -> Identity (Set Addr)) -> SubState -> Identity SubState
Lens' SubState (Set Addr)
accessedAddresses) (Addr -> Set Addr -> Set Addr
forall a. Ord a => a -> Set a -> Set a
insert Addr
addr Set Addr
accessedAddrs)
  Bool -> EVM Bool
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 -> SymWord -> EVM Bool
accessStorageForGas :: Addr -> SymWord -> EVM Bool
accessStorageForGas Addr
addr SymWord
key = do
  Set (Addr, W256)
accessedStrkeys <- Getting (Set (Addr, W256)) VM (Set (Addr, W256))
-> StateT VM Identity (Set (Addr, W256))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const (Set (Addr, W256)) TxState)
-> VM -> Const (Set (Addr, W256)) VM
Lens' VM TxState
tx ((TxState -> Const (Set (Addr, W256)) TxState)
 -> VM -> Const (Set (Addr, W256)) VM)
-> ((Set (Addr, W256)
     -> Const (Set (Addr, W256)) (Set (Addr, W256)))
    -> TxState -> Const (Set (Addr, W256)) TxState)
-> Getting (Set (Addr, W256)) VM (Set (Addr, W256))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const (Set (Addr, W256)) SubState)
-> TxState -> Const (Set (Addr, W256)) TxState
Lens' TxState SubState
substate ((SubState -> Const (Set (Addr, W256)) SubState)
 -> TxState -> Const (Set (Addr, W256)) TxState)
-> ((Set (Addr, W256)
     -> Const (Set (Addr, W256)) (Set (Addr, W256)))
    -> SubState -> Const (Set (Addr, W256)) SubState)
-> (Set (Addr, W256)
    -> Const (Set (Addr, W256)) (Set (Addr, W256)))
-> TxState
-> Const (Set (Addr, W256)) TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Addr, W256) -> Const (Set (Addr, W256)) (Set (Addr, W256)))
-> SubState -> Const (Set (Addr, W256)) SubState
Lens' SubState (Set (Addr, W256))
accessedStorageKeys)
  case SymWord -> Maybe Word
maybeLitWord SymWord
key of
    Just Word
litword -> do
      let litword256 :: W256
litword256 = Word -> W256
wordValue Word
litword
      let accessed :: Bool
accessed = (Addr, W256) -> Set (Addr, W256) -> Bool
forall a. Ord a => a -> Set a -> Bool
member (Addr
addr, W256
litword256) Set (Addr, W256)
accessedStrkeys
      ASetter VM VM (Set (Addr, W256)) (Set (Addr, W256))
-> Set (Addr, W256) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((TxState -> Identity TxState) -> VM -> Identity VM
Lens' VM TxState
tx ((TxState -> Identity TxState) -> VM -> Identity VM)
-> ((Set (Addr, W256) -> Identity (Set (Addr, W256)))
    -> TxState -> Identity TxState)
-> ASetter VM VM (Set (Addr, W256)) (Set (Addr, W256))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Identity SubState) -> TxState -> Identity TxState
Lens' TxState SubState
substate ((SubState -> Identity SubState) -> TxState -> Identity TxState)
-> ((Set (Addr, W256) -> Identity (Set (Addr, W256)))
    -> SubState -> Identity SubState)
-> (Set (Addr, W256) -> Identity (Set (Addr, W256)))
-> TxState
-> Identity TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Addr, W256) -> Identity (Set (Addr, W256)))
-> SubState -> Identity SubState
Lens' SubState (Set (Addr, W256))
accessedStorageKeys) ((Addr, W256) -> Set (Addr, W256) -> Set (Addr, W256)
forall a. Ord a => a -> Set a -> Set a
insert (Addr
addr, W256
litword256) Set (Addr, W256)
accessedStrkeys)
      Bool -> EVM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
accessed
    Maybe Word
_ -> Bool -> EVM Bool
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 = W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num (ByteString -> W256
keccak ByteString
"hevm cheat code")

cheat
  :: (?op :: Word8)
  => (Word, Word) -> (Word, Word)
  -> EVM ()
cheat :: (Word, Word) -> (Word, Word) -> EVM ()
cheat (Word
inOffset, Word
inSize) (Word
outOffset, Word
outSize) = do
  Buffer
mem <- Getting Buffer VM Buffer -> StateT VM Identity Buffer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory)
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let
    abi :: SWord 32
abi = Word -> Buffer -> SWord 32
readMemoryWord32 Word
inOffset Buffer
mem
    input :: Buffer
input = Word -> Word -> VM -> Buffer
readMemory (Word
inOffset Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
4) (Word
inSize Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
4) VM
vm
  case WordN 32 -> Word32
forall a. FromSizedBV a => a -> FromSized a
fromSized (WordN 32 -> Word32) -> Maybe (WordN 32) -> Maybe Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SWord 32 -> Maybe (WordN 32)
forall a. SymVal a => SBV a -> Maybe a
unliteral SWord 32
abi of
    Maybe Word32
Nothing -> Error -> EVM ()
vmError Error
UnexpectedSymbolicArg
    Just Word32
abi' ->
      case Word32 -> Map Word32 CheatAction -> Maybe CheatAction
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 (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
abi'))
        Just CheatAction
action -> do
            CheatAction
action Word
outOffset Word
outSize Buffer
input
            EVM ()
(?op::Word8) => EVM ()
next
            Word -> EVM ()
push Word
1

type CheatAction = Word -> Word -> Buffer -> EVM ()

cheatActions :: Map Word32 CheatAction
cheatActions :: Map Word32 CheatAction
cheatActions =
  [(Word32, CheatAction)] -> Map Word32 CheatAction
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"ffi(string[])" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
outOffset Word
outSize Buffer
input -> do
          VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
          if Getting Bool VM Bool -> VM -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool VM Bool
Lens' VM Bool
EVM.allowFFI VM
vm then
            case [AbiType] -> Buffer -> AbiVals
decodeBuffer [AbiType -> AbiType
AbiArrayDynamicType AbiType
AbiStringType] Buffer
input of
              CAbi [AbiValue]
valsArr -> case [AbiValue]
valsArr of
                [AbiArrayDynamic AbiType
AbiStringType Vector AbiValue
strsV] ->
                  let
                    cmd :: [String]
cmd = (((AbiValue -> String) -> [AbiValue] -> [String])
-> [AbiValue] -> (AbiValue -> String) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AbiValue -> String) -> [AbiValue] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
V.toList Vector AbiValue
strsV) (\case
                      (AbiString ByteString
a) -> Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
a
                      AbiValue
_ -> String
"")
                    cont :: ByteString -> EVM ()
cont ByteString
bs = do
                      let encoded :: Buffer
encoded = ByteString -> Buffer
ConcreteBuffer ByteString
bs
                      ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
encoded
                      Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
encoded Word
outSize Word
0 Word
outOffset
                      ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result Maybe VMResult
forall a. Maybe a
Nothing
                  in ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> (Query -> VMResult) -> Query -> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> VMResult
VMFailure (Error -> VMResult) -> (Query -> Error) -> Query -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Error
Query (Query -> Maybe VMResult) -> Query -> Maybe VMResult
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 (Error -> EVM ()) -> (ByteString -> Error) -> ByteString -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Error
Revert (ByteString -> EVM ()) -> ByteString -> EVM ()
forall a b. (a -> b) -> a -> b
$ Text -> AbiValue -> ByteString
abiMethod Text
"Error(string)" (Vector AbiValue -> AbiValue
AbiTuple (Vector AbiValue -> AbiValue)
-> ([AbiValue] -> Vector AbiValue) -> [AbiValue] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
V.fromList ([AbiValue] -> AbiValue) -> [AbiValue] -> AbiValue
forall a b. (a -> b) -> a -> b
$ [ByteString -> AbiValue
AbiString ByteString
msg]),

      ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"warp(uint256)" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
_ Word
_ Buffer
input -> case Buffer -> [SymWord]
decodeStaticArgs Buffer
input of
          [SymWord
x]  -> ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Block -> Identity Block) -> VM -> Identity VM
Lens' VM Block
block ((Block -> Identity Block) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord) -> Block -> Identity Block)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymWord -> Identity SymWord) -> Block -> Identity Block
Lens' Block SymWord
timestamp) SymWord
x
          [SymWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"roll(uint256)" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
_ Word
_ Buffer
input -> case Buffer -> [SymWord]
decodeStaticArgs Buffer
input of
          [SymWord
x] -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
x (((Word -> Identity Word) -> VM -> Identity VM) -> Word -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Block -> Identity Block) -> VM -> Identity VM
Lens' VM Block
block ((Block -> Identity Block) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Block -> Identity Block)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Block -> Identity Block
Lens' Block Word
number))
          [SymWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"store(address,bytes32,bytes32)" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
_ Word
_ Buffer
input -> case Buffer -> [SymWord]
decodeStaticArgs Buffer
input of
          [SymWord
a, SymWord
slot, SymWord
new] ->
            SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique SymWord
a ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(C Whiff
_ (W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num -> Addr
a')) ->
              Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
a' ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                ASetter VM VM Storage Storage -> (Storage -> Storage) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Env -> Identity Env)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Storage -> Identity Storage)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
a' ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ASetter Contract Contract Storage Storage
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage) (SymWord -> SymWord -> Storage -> Storage
writeStorage SymWord
slot SymWord
new)
          [SymWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"load(address,bytes32)" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
outOffset Word
_ Buffer
input -> case Buffer -> [SymWord]
decodeStaticArgs Buffer
input of
          [SymWord
a, SymWord
slot] ->
            SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique SymWord
a ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(C Whiff
_ (W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num -> Addr
a'))->
              Addr -> SymWord -> (SymWord -> EVM ()) -> EVM ()
accessStorage Addr
a' SymWord
slot ((SymWord -> EVM ()) -> EVM ()) -> (SymWord -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \SymWord
res -> do
                ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> ((SymWord -> Identity SymWord) -> Buffer -> Identity Buffer)
-> (SymWord -> Identity SymWord)
-> FrameState
-> Identity FrameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (SymWord -> Identity SymWord) -> Buffer -> Identity Buffer
forall (f :: * -> *).
Functor f =>
Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At Word
0) SymWord
res
                ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> ((SymWord -> Identity SymWord) -> Buffer -> Identity Buffer)
-> (SymWord -> Identity SymWord)
-> FrameState
-> Identity FrameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (SymWord -> Identity SymWord) -> Buffer -> Identity Buffer
forall (f :: * -> *).
Functor f =>
Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At Word
outOffset) SymWord
res
          [SymWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"sign(uint256,bytes32)" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
outOffset Word
_ Buffer
input -> case Buffer -> [SymWord]
decodeStaticArgs Buffer
input of
          [SymWord
sk, SymWord
hash] ->
            SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
sk ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
sk' ->
              SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
hash ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(C Whiff
_ W256
hash') -> let
                curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1
                priv :: PrivateKey
priv = Curve -> Integer -> PrivateKey
PrivateKey Curve
curve (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
sk')
                digest :: Maybe (Digest Keccak_256)
digest = ByteString -> Maybe (Digest Keccak_256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString (W256 -> ByteString
word256Bytes W256
hash')
              in do
                case Maybe (Digest Keccak_256)
digest of
                  Maybe (Digest Keccak_256)
Nothing -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig)
                  Just Digest Keccak_256
digest' -> do
                    let s :: Signature
s = PrivateKey -> Digest Keccak_256 -> Signature
ethsign PrivateKey
priv Digest Keccak_256
digest'
                        v :: Word256
v = if (Signature -> Integer
sign_s Signature
s) Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
2 Ratio Integer -> Ratio Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Integer
0 then Word256
27 else Word256
28
                        encoded :: ByteString
encoded = AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString) -> AbiValue -> ByteString
forall a b. (a -> b) -> a -> b
$
                          Vector AbiValue -> AbiValue
AbiTuple ([AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
RegularVector.fromList
                            [ Int -> Word256 -> AbiValue
AbiUInt Int
8 Word256
v
                            , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes (W256 -> ByteString) -> (Integer -> W256) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> W256
forall a. Num a => Integer -> a
fromInteger (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Signature -> Integer
sign_r Signature
s)
                            , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes (W256 -> ByteString) -> (Integer -> W256) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> W256
forall a. Num a => Integer -> a
fromInteger (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Signature -> Integer
sign_s Signature
s)
                            ])
                    ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) (ByteString -> Buffer
ConcreteBuffer ByteString
encoded)
                    Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory (ByteString -> Buffer
ConcreteBuffer ByteString
encoded) (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Int -> Word) -> (ByteString -> Int) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ ByteString
encoded) Word
0 Word
outOffset
          [SymWord]
_ -> Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig),

      ByteString
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall b. ByteString -> (Maybe Word32 -> b) -> (Word32, b)
action ByteString
"addr(uint256)" ((Maybe Word32 -> CheatAction) -> (Word32, CheatAction))
-> (Maybe Word32 -> CheatAction) -> (Word32, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \Maybe Word32
sig Word
outOffset Word
_ Buffer
input -> case Buffer -> [SymWord]
decodeStaticArgs Buffer
input of
          [SymWord
sk] -> SymWord -> (Word -> EVM ()) -> EVM ()
forceConcrete SymWord
sk ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word
sk' -> let
                curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1
                pubPoint :: Point
pubPoint = Curve -> Integer -> Point
generateQ Curve
curve (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
sk')
                encodeInt :: Integer -> ByteString
encodeInt = AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString)
-> (Integer -> AbiValue) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word256 -> AbiValue
AbiUInt Int
256 (Word256 -> AbiValue)
-> (Integer -> Word256) -> Integer -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word256
forall a. Num a => Integer -> a
fromInteger
              in do
                case Point
pubPoint of
                  Point
PointO -> do Error -> EVM ()
vmError (Maybe Word32 -> Error
BadCheatCode Maybe Word32
sig)
                  Point Integer
x Integer
y -> do
                    -- See yellow paper #286
                    let
                      pub :: ByteString
pub = [ByteString] -> ByteString
BS.concat [ Integer -> ByteString
encodeInt Integer
x, Integer -> ByteString
encodeInt Integer
y ]
                      addr :: SymWord
addr = W256 -> SymWord
w256lit (W256 -> SymWord) -> (ByteString -> W256) -> ByteString -> SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word256 -> W256
forall a b. (Integral a, Num b) => a -> b
num (Word256 -> W256) -> (ByteString -> Word256) -> ByteString -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word256
word256 (ByteString -> Word256)
-> (ByteString -> ByteString) -> ByteString -> Word256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
12 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
32 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
keccakBytes (ByteString -> SymWord) -> ByteString -> SymWord
forall a b. (a -> b) -> a -> b
$ ByteString
pub
                    ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> ((SymWord -> Identity SymWord) -> Buffer -> Identity Buffer)
-> (SymWord -> Identity SymWord)
-> FrameState
-> Identity FrameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (SymWord -> Identity SymWord) -> Buffer -> Identity Buffer
forall (f :: * -> *).
Functor f =>
Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At Word
0) SymWord
addr
                    ASetter VM VM SymWord SymWord -> SymWord -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((SymWord -> Identity SymWord)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM SymWord SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> ((SymWord -> Identity SymWord) -> Buffer -> Identity Buffer)
-> (SymWord -> Identity SymWord)
-> FrameState
-> Identity FrameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (SymWord -> Identity SymWord) -> Buffer -> Identity Buffer
forall (f :: * -> *).
Functor f =>
Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At Word
outOffset) SymWord
addr
          [SymWord]
_ -> 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 (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Word32
abiKeccak ByteString
s))

-- | Hack deterministic signing, totally insecure...
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 Integer -> PrivateKey -> Digest Keccak_256 -> Maybe Signature
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 Integer -> Integer -> Integer
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 -> Word -> SAddr -> SAddr -> Word -> Word -> Word -> Word -> Word -> [SymWord]
  -> (Addr -> EVM ())
  -> EVM ()
delegateCall :: Contract
-> Word
-> SAddr
-> SAddr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word
gasGiven (SAddr SWord 160
xTo) (SAddr SWord 160
xContext) Word
xValue Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs Addr -> EVM ()
continue =
  SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique (Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo String
"xTo" []) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SWord 160 -> SWord 256
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 160
xTo) ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(C Whiff
_ (W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num -> Addr
xTo')) ->
    SymWord -> (Word -> EVM ()) -> EVM ()
makeUnique (Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo String
"xcontext" []) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ SWord 160 -> SWord 256
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord 160
xContext) ((Word -> EVM ()) -> EVM ()) -> (Word -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(C Whiff
_ (W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num -> Addr
xContext')) ->
      if Addr
xTo' Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
> Addr
0 Bool -> Bool -> Bool
&& Addr
xTo' Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
<= Addr
9
      then (?op::Word8) =>
Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> EVM ()
Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> EVM ()
precompiledContract Contract
this Word
gasGiven Addr
xTo' Addr
xContext' Word
xValue Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs
      else if Addr -> Addr
forall a b. (Integral a, Num b) => a -> b
num Addr
xTo' Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
cheatCode then
        do
          ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) [SymWord]
xs
          (?op::Word8) => (Word, Word) -> (Word, Word) -> EVM ()
(Word, Word) -> (Word, Word) -> EVM ()
cheat (Word
xInOffset, Word
xInSize) (Word
xOutOffset, Word
xOutSize)
      else
        (?op::Word8) =>
Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Integer -> EVM ())
-> EVM ()
Contract
-> Word
-> Addr
-> Addr
-> Word
-> Word
-> Word
-> Word
-> Word
-> [SymWord]
-> (Integer -> EVM ())
-> EVM ()
callChecks Contract
this Word
gasGiven Addr
xContext' Addr
xTo' Word
xValue Word
xInOffset Word
xInSize Word
xOutOffset Word
xOutSize [SymWord]
xs ((Integer -> EVM ()) -> EVM ()) -> (Integer -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
        \Integer
xGas -> do
          VM
vm0 <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
          Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
xTo' ((Contract -> EVM ()) -> EVM ())
-> (EVM () -> Contract -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EVM () -> Contract -> EVM ()
forall a b. a -> b -> a
const (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Getting (First Contract) VM Contract
-> StateT VM Identity (Maybe Contract)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse ((Env -> Const (First Contract) Env)
-> VM -> Const (First Contract) VM
Lens' VM Env
env ((Env -> Const (First Contract) Env)
 -> VM -> Const (First Contract) VM)
-> ((Contract -> Const (First Contract) Contract)
    -> Env -> Const (First Contract) Env)
-> Getting (First Contract) VM Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (First Contract) (Map Addr Contract))
-> Env -> Const (First Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (First Contract) (Map Addr Contract))
 -> Env -> Const (First Contract) Env)
-> Getting (First Contract) (Map Addr Contract) Contract
-> (Contract -> Const (First Contract) Contract)
-> Env
-> Const (First Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
xTo') StateT VM Identity (Maybe Contract)
-> (Maybe Contract -> EVM ()) -> EVM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe Contract
Nothing ->
                Error -> EVM ()
vmError (Addr -> Error
NoSuchContract Addr
xTo')
              Just Contract
target -> do
                Integer -> EVM () -> EVM ()
burn Integer
xGas (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  let newContext :: FrameContext
newContext = CallContext :: Addr
-> Addr
-> Word
-> Word
-> W256
-> Maybe Word
-> Buffer
-> Map Addr Contract
-> SubState
-> FrameContext
CallContext
                                    { callContextTarget :: Addr
callContextTarget    = Addr
xTo'
                                    , callContextContext :: Addr
callContextContext   = Addr
xContext'
                                    , callContextOffset :: Word
callContextOffset    = Word
xOutOffset
                                    , callContextSize :: Word
callContextSize      = Word
xOutSize
                                    , callContextCodehash :: W256
callContextCodehash  = Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
target
                                    , callContextReversion :: Map Addr Contract
callContextReversion = Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
vm0
                                    , callContextSubState :: SubState
callContextSubState  = Getting SubState VM SubState -> VM -> SubState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxState -> Const SubState TxState) -> VM -> Const SubState VM
Lens' VM TxState
tx ((TxState -> Const SubState TxState) -> VM -> Const SubState VM)
-> ((SubState -> Const SubState SubState)
    -> TxState -> Const SubState TxState)
-> Getting SubState VM SubState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const SubState SubState)
-> TxState -> Const SubState TxState
Lens' TxState SubState
substate) VM
vm0
                                    , callContextAbi :: Maybe Word
callContextAbi =
                                        if Word
xInSize Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
4
                                        then case SWord 32 -> Maybe (WordN 32)
forall a. SymVal a => SBV a -> Maybe a
unliteral (SWord 32 -> Maybe (WordN 32)) -> SWord 32 -> Maybe (WordN 32)
forall a b. (a -> b) -> a -> b
$ Word -> Buffer -> SWord 32
readMemoryWord32 Word
xInOffset (Getting Buffer VM Buffer -> VM -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory) VM
vm0)
                                             of Maybe (WordN 32)
Nothing -> Maybe Word
forall a. Maybe a
Nothing
                                                Just WordN 32
abi -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word) -> (W256 -> Word) -> W256 -> Maybe Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> Word
w256 (W256 -> Maybe Word) -> W256 -> Maybe Word
forall a b. (a -> b) -> a -> b
$ WordN 32 -> W256
forall a b. (Integral a, Num b) => a -> b
num WordN 32
abi
                                        else Maybe Word
forall a. Maybe a
Nothing
                                    , callContextData :: Buffer
callContextData = (Word -> Word -> VM -> Buffer
readMemory (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xInOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xInSize) VM
vm0)
                                    }

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

                  ASetter VM VM [Frame] [Frame] -> Frame -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo ASetter VM VM [Frame] [Frame]
Lens' VM [Frame]
frames (Frame -> EVM ()) -> Frame -> EVM ()
forall a b. (a -> b) -> a -> b
$ Frame :: FrameContext -> FrameState -> Frame
Frame
                    { _frameState :: FrameState
_frameState = ((([SymWord] -> Identity [SymWord])
 -> FrameState -> Identity FrameState)
-> [SymWord] -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack [SymWord]
xs) (Getting FrameState VM FrameState -> VM -> FrameState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameState VM FrameState
Lens' VM FrameState
state VM
vm1)
                    , _frameContext :: FrameContext
_frameContext = FrameContext
newContext
                    }

                  LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
-> StateT FrameState Identity () -> EVM ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT FrameState Identity) ()) VM FrameState
Lens' VM FrameState
state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    ((Word -> Identity Word) -> FrameState -> Identity FrameState)
-> Word -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Word -> Identity Word) -> FrameState -> Identity FrameState
Lens' FrameState Word
gas (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
num Integer
xGas)
                    ((Int -> Identity Int) -> FrameState -> Identity FrameState)
-> Int -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Int -> Identity Int) -> FrameState -> Identity FrameState
Lens' FrameState Int
pc Int
0
                    ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> Buffer -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
code (Getting Buffer Contract Buffer -> Contract -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode Contract
target)
                    ASetter FrameState FrameState Addr Addr
-> Addr -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
codeContract Addr
xTo'
                    (([SymWord] -> Identity [SymWord])
 -> FrameState -> Identity FrameState)
-> [SymWord] -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack [SymWord]
forall a. Monoid a => a
mempty
                    ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> Buffer -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory Buffer
forall a. Monoid a => a
mempty
                    ((Int -> Identity Int) -> FrameState -> Identity FrameState)
-> Int -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Int -> Identity Int) -> FrameState -> Identity FrameState
Lens' FrameState Int
memorySize Int
0
                    ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> Buffer -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata Buffer
forall a. Monoid a => a
mempty
                    ASetter FrameState FrameState (Buffer, SymWord) (Buffer, SymWord)
-> (Buffer, SymWord) -> StateT FrameState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter FrameState FrameState (Buffer, SymWord) (Buffer, SymWord)
Lens' FrameState (Buffer, SymWord)
calldata (Word -> Word -> VM -> Buffer
readMemory (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xInOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num Word
xInSize) VM
vm0, W256 -> SymWord
w256lit (Word -> W256
forall a b. (Integral a, Num b) => a -> b
num Word
xInSize))

                  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 -> (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
c Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0) Bool -> Bool -> Bool
|| case Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
c of
    RuntimeCode Buffer
b -> Buffer -> Int
len Buffer
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    ContractCode
_ -> Bool
True
  Maybe Contract
Nothing -> Bool
False

create :: (?op :: Word8)
  => Addr -> Contract
  -> Word -> Word -> [SymWord] -> Addr -> Buffer -> EVM ()
create :: Addr
-> Contract
-> Word
-> Word
-> [SymWord]
-> Addr
-> Buffer
-> EVM ()
create Addr
self Contract
this Word
xGas' Word
xValue [SymWord]
xs Addr
newAddr Buffer
initCode = do
  VM
vm0 <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let xGas :: Integer
xGas = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
xGas'
  if Word
xValue Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
this
  then do
    ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
    ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace (Error -> TraceData) -> Error -> TraceData
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Error
BalanceTooLow Word
xValue (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
this)
    EVM ()
(?op::Word8) => EVM ()
next
  else if [Frame] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
vm0) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024
  then do
    ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
    ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ Error -> TraceData
ErrorTrace Error
CallDepthLimitReached
    EVM ()
(?op::Word8) => EVM ()
next
  else if Maybe Contract -> Bool
collision (Maybe Contract -> Bool) -> Maybe Contract -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Contract) VM (Maybe Contract)
-> VM -> Maybe Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Maybe Contract) Env)
-> VM -> Const (Maybe Contract) VM
Lens' VM Env
env ((Env -> Const (Maybe Contract) Env)
 -> VM -> Const (Maybe Contract) VM)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Env -> Const (Maybe Contract) Env)
-> Getting (Maybe Contract) VM (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> Env -> Const (Maybe Contract) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
 -> Env -> Const (Maybe Contract) Env)
-> ((Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
    -> Map Addr Contract -> Const (Maybe Contract) (Map Addr Contract))
-> (Maybe Contract -> Const (Maybe Contract) (Maybe Contract))
-> Env
-> Const (Maybe Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
newAddr) VM
vm0
  then Integer -> EVM () -> EVM ()
burn Integer
xGas (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
    ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack) (SymWord
0 SymWord -> [SymWord] -> [SymWord]
forall a. a -> [a] -> [a]
: [SymWord]
xs)
    ((Word -> Identity Word) -> VM -> Identity VM)
-> (Word -> Word) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Env -> Identity Env)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> Env -> Identity Env)
-> ((Word -> Identity Word)
    -> Map Addr Contract -> Identity (Map Addr Contract))
-> (Word -> Identity Word)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
self ((Contract -> Identity Contract)
 -> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Identity Word)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
nonce) Word -> Word
forall a. Enum a => a -> a
succ
    EVM ()
(?op::Word8) => EVM ()
next
  else Integer -> EVM () -> EVM ()
burn Integer
xGas (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
    Addr -> EVM ()
touchAccount Addr
self
    Addr -> EVM ()
touchAccount Addr
newAddr
    let
      store :: Storage
store = case Getting StorageModel VM StorageModel -> VM -> StorageModel
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const StorageModel Env) -> VM -> Const StorageModel VM
Lens' VM Env
env ((Env -> Const StorageModel Env) -> VM -> Const StorageModel VM)
-> ((StorageModel -> Const StorageModel StorageModel)
    -> Env -> Const StorageModel Env)
-> Getting StorageModel VM StorageModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageModel -> Const StorageModel StorageModel)
-> Env -> Const StorageModel Env
Lens' Env StorageModel
storageModel) VM
vm0 of
        StorageModel
ConcreteS -> Map Word SymWord -> Storage
Concrete Map Word SymWord
forall a. Monoid a => a
mempty
        StorageModel
SymbolicS -> [(SymWord, SymWord)] -> SArray (WordN 256) (WordN 256) -> Storage
Symbolic [] (SArray (WordN 256) (WordN 256) -> Storage)
-> SArray (WordN 256) (WordN 256) -> Storage
forall a b. (a -> b) -> a -> b
$ WordN 256
-> [(SWord 256, SWord 256)] -> SArray (WordN 256) (WordN 256)
forall (array :: * -> * -> *) a b.
(SymArray array, HasKind a, SymVal b) =>
b -> [(SBV a, SBV b)] -> array a b
sListArray WordN 256
0 []
        StorageModel
InitialS  -> [(SymWord, SymWord)] -> SArray (WordN 256) (WordN 256) -> Storage
Symbolic [] (SArray (WordN 256) (WordN 256) -> Storage)
-> SArray (WordN 256) (WordN 256) -> Storage
forall a b. (a -> b) -> a -> b
$ WordN 256
-> [(SWord 256, SWord 256)] -> SArray (WordN 256) (WordN 256)
forall (array :: * -> * -> *) a b.
(SymArray array, HasKind a, SymVal b) =>
b -> [(SBV a, SBV b)] -> array a b
sListArray WordN 256
0 []
      newContract :: Contract
newContract =
        ContractCode -> Contract
initialContract (Buffer -> ContractCode
InitCode Buffer
initCode) Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage Storage
store
      newContext :: FrameContext
newContext  =
        CreationContext :: Addr -> W256 -> Map Addr Contract -> SubState -> FrameContext
CreationContext { creationContextAddress :: Addr
creationContextAddress   = Addr
newAddr
                        , creationContextCodehash :: W256
creationContextCodehash  = Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
newContract
                        , creationContextReversion :: Map Addr Contract
creationContextReversion = Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
vm0
                        , creationContextSubstate :: SubState
creationContextSubstate  = Getting SubState VM SubState -> VM -> SubState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxState -> Const SubState TxState) -> VM -> Const SubState VM
Lens' VM TxState
tx ((TxState -> Const SubState TxState) -> VM -> Const SubState VM)
-> ((SubState -> Const SubState SubState)
    -> TxState -> Const SubState TxState)
-> Getting SubState VM SubState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const SubState SubState)
-> TxState -> Const SubState TxState
Lens' TxState SubState
substate) VM
vm0
                        }

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

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

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

    TraceData -> EVM ()
pushTrace (FrameContext -> TraceData
FrameTrace FrameContext
newContext)
    EVM ()
(?op::Word8) => EVM ()
next
    VM
vm1 <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    ASetter VM VM [Frame] [Frame] -> Frame -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter s s [a] [a] -> a -> m ()
pushTo ASetter VM VM [Frame] [Frame]
Lens' VM [Frame]
frames (Frame -> EVM ()) -> Frame -> EVM ()
forall a b. (a -> b) -> a -> b
$ Frame :: FrameContext -> FrameState -> Frame
Frame
      { _frameContext :: FrameContext
_frameContext = FrameContext
newContext
      , _frameState :: FrameState
_frameState   = ((([SymWord] -> Identity [SymWord])
 -> FrameState -> Identity FrameState)
-> [SymWord] -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack [SymWord]
xs) (Getting FrameState VM FrameState -> VM -> FrameState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameState VM FrameState
Lens' VM FrameState
state VM
vm1)
      }

    ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> FrameState -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state (FrameState -> EVM ()) -> FrameState -> EVM ()
forall a b. (a -> b) -> a -> b
$
      FrameState
blankState
        FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& ASetter FrameState FrameState Addr Addr
-> Addr -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
contract   Addr
newAddr
        FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& ASetter FrameState FrameState Addr Addr
-> Addr -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FrameState FrameState Addr Addr
Lens' FrameState Addr
codeContract Addr
newAddr
        FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& ((Buffer -> Identity Buffer) -> FrameState -> Identity FrameState)
-> Buffer -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
code       Buffer
initCode
        FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& ((SymWord -> Identity SymWord)
 -> FrameState -> Identity FrameState)
-> SymWord -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set (SymWord -> Identity SymWord) -> FrameState -> Identity FrameState
Lens' FrameState SymWord
callvalue  (Word -> SymWord
litWord Word
xValue)
        FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& ASetter FrameState FrameState SAddr SAddr
-> SAddr -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FrameState FrameState SAddr SAddr
Lens' FrameState SAddr
caller     (Addr -> SAddr
litAddr Addr
self)
        FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& ((Word -> Identity Word) -> FrameState -> Identity FrameState)
-> Word -> FrameState -> FrameState
forall s t a b. ASetter s t a b -> b -> s -> t
set (Word -> Identity Word) -> FrameState -> Identity FrameState
Lens' FrameState Word
gas        Word
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 =
  LensLike'
  (Zoomed (StateT (Maybe Contract) Identity) ()) VM (Maybe Contract)
-> StateT (Maybe Contract) Identity () -> EVM ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Env -> Focusing Identity () Env) -> VM -> Focusing Identity () VM
Lens' VM Env
env ((Env -> Focusing Identity () Env)
 -> VM -> Focusing Identity () VM)
-> ((Maybe Contract -> Focusing Identity () (Maybe Contract))
    -> Env -> Focusing Identity () Env)
-> (Maybe Contract -> Focusing Identity () (Maybe Contract))
-> VM
-> Focusing Identity () VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Focusing Identity () (Map Addr Contract))
-> Env -> Focusing Identity () Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Focusing Identity () (Map Addr Contract))
 -> Env -> Focusing Identity () Env)
-> ((Maybe Contract -> Focusing Identity () (Maybe Contract))
    -> Map Addr Contract -> Focusing Identity () (Map Addr Contract))
-> (Maybe Contract -> Focusing Identity () (Maybe Contract))
-> Env
-> Focusing Identity () Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
target) (StateT (Maybe Contract) Identity () -> EVM ())
-> StateT (Maybe Contract) Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$
    StateT (Maybe Contract) Identity (Maybe Contract)
forall s (m :: * -> *). MonadState s m => m s
get StateT (Maybe Contract) Identity (Maybe Contract)
-> (Maybe Contract -> StateT (Maybe Contract) Identity ())
-> StateT (Maybe Contract) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Contract
now -> case (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
now) of
        InitCode Buffer
_ ->
          Maybe Contract -> StateT (Maybe Contract) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe Contract -> StateT (Maybe Contract) Identity ())
-> (Contract -> Maybe Contract)
-> Contract
-> StateT (Maybe Contract) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract -> Maybe Contract
forall a. a -> Maybe a
Just (Contract -> StateT (Maybe Contract) Identity ())
-> Contract -> StateT (Maybe Contract) Identity ()
forall a b. (a -> b) -> a -> b
$
          ContractCode -> Contract
initialContract ContractCode
newCode
          Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
now)
          Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ((Word -> Identity Word) -> Contract -> Identity Contract)
-> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
balance (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
now)
          Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ((Word -> Identity Word) -> Contract -> Identity Contract)
-> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
nonce   (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
now)
        RuntimeCode Buffer
_ ->
          String -> StateT (Maybe Contract) Identity ()
forall a. HasCallStack => String -> a
error (String
"internal error: can't replace code of deployed contract " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Addr -> String
forall a. Show a => a -> String
show Addr
target)
      Maybe Contract
Nothing ->
        String -> StateT (Maybe Contract) Identity ()
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 <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  Addr -> ContractCode -> EVM ()
replaceCode (Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract) VM
vm) ContractCode
newCode

resetState :: EVM ()
resetState :: EVM ()
resetState = do
  ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result Maybe VMResult
forall a. Maybe a
Nothing
  ASetter VM VM [Frame] [Frame] -> [Frame] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM [Frame] [Frame]
Lens' VM [Frame]
frames []
  ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> FrameState -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (FrameState -> Identity FrameState) -> VM -> Identity VM
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
StackUnderrun

-- | A stack frame can be popped in three ways.
data FrameResult
  = FrameReturned Buffer -- ^ STOP, RETURN, or no more code
  | FrameReverted Buffer -- ^ REVERT
  | FrameErrored Error -- ^ Any other error
  deriving Int -> FrameResult -> ShowS
[FrameResult] -> ShowS
FrameResult -> String
(Int -> FrameResult -> ShowS)
-> (FrameResult -> String)
-> ([FrameResult] -> ShowS)
-> Show FrameResult
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 <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get

  case Getting [Frame] VM [Frame] -> VM -> [Frame]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Frame] VM [Frame]
Lens' VM [Frame]
frames VM
oldVm of
    -- Is the current frame the only one?
    [] -> do
      case FrameResult
how of
          FrameReturned Buffer
output -> ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (VMResult -> Maybe VMResult) -> VMResult -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> EVM ()) -> VMResult -> EVM ()
forall a b. (a -> b) -> a -> b
$ Buffer -> VMResult
VMSuccess Buffer
output
          FrameReverted Buffer
buffer -> Buffer -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuffer Buffer
buffer ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
out -> ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (VMResult -> Maybe VMResult) -> VMResult -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> EVM ()) -> VMResult -> EVM ()
forall a b. (a -> b) -> a -> b
$ Error -> VMResult
VMFailure (ByteString -> Error
Revert ByteString
out)
          FrameErrored Error
e       -> ASetter VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter VM VM (Maybe VMResult) (Maybe VMResult)
Lens' VM (Maybe VMResult)
result (Maybe VMResult -> EVM ())
-> (VMResult -> Maybe VMResult) -> VMResult -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> EVM ()) -> VMResult -> EVM ()
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 (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$
        case FrameResult
how of
          FrameErrored Error
e ->
            Error -> TraceData
ErrorTrace Error
e
          FrameReverted (ConcreteBuffer ByteString
output) ->
            Error -> TraceData
ErrorTrace (ByteString -> Error
Revert ByteString
output)
          FrameReverted (SymbolicBuffer [SWord 8]
output) ->
            Error -> TraceData
ErrorTrace (ByteString -> Error
Revert ([SWord 8] -> ByteString
forceLitBytes [SWord 8]
output))
          FrameReturned Buffer
output ->
            Buffer -> FrameContext -> TraceData
ReturnTrace Buffer
output (Getting FrameContext Frame FrameContext -> Frame -> FrameContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameContext Frame FrameContext
Lens' Frame FrameContext
frameContext Frame
nextFrame)
      -- Pop to the previous level of the debug trace stack.
      EVM ()
popTrace

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

      -- 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 :: Word
remainingGas = Getting Word VM Word -> VM -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Word FrameState) -> VM -> Const Word VM
Lens' VM FrameState
state ((FrameState -> Const Word FrameState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word)
    -> FrameState -> Const Word FrameState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> FrameState -> Const Word FrameState
Lens' FrameState Word
gas) VM
oldVm
          reclaimRemainingGasAllowance :: EVM ()
reclaimRemainingGasAllowance = do
            ((Word -> Identity Word) -> VM -> Identity VM)
-> (Word -> Word) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying (Word -> Identity Word) -> VM -> Identity VM
Lens' VM Word
burned (Word -> Word -> Word
forall a. Num a => a -> a -> a
subtract Word
remainingGas)
            ((Word -> Identity Word) -> VM -> Identity VM)
-> (Word -> Word) -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> FrameState -> Identity FrameState)
-> (Word -> Identity Word)
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> FrameState -> Identity FrameState
Lens' FrameState Word
gas) (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
remainingGas)

          FeeSchedule {Integer
g_access_list_storage_key :: Integer
g_access_list_address :: Integer
g_warm_storage_read :: Integer
g_cold_account_access :: Integer
g_cold_sload :: Integer
r_block :: Integer
g_fround :: Integer
g_pairing_base :: Integer
g_pairing_point :: Integer
g_ecmul :: Integer
g_ecadd :: Integer
g_quaddivisor :: Integer
g_extcodehash :: Integer
g_blockhash :: Integer
g_copy :: Integer
g_sha3word :: Integer
g_sha3 :: Integer
g_logtopic :: Integer
g_logdata :: Integer
g_log :: Integer
g_transaction :: Integer
g_txdatanonzero :: Integer
g_txdatazero :: Integer
g_txcreate :: Integer
g_memory :: Integer
g_expbyte :: Integer
g_exp :: Integer
g_newaccount :: Integer
g_callstipend :: Integer
g_callvalue :: Integer
g_call :: Integer
g_codedeposit :: Integer
g_create :: Integer
r_selfdestruct :: Integer
g_selfdestruct_newaccount :: Integer
g_selfdestruct :: Integer
r_sclear :: Integer
g_sreset :: Integer
g_sset :: Integer
g_jumpdest :: Integer
g_sload :: Integer
g_balance :: Integer
g_extcode :: Integer
g_high :: Integer
g_mid :: Integer
g_low :: Integer
g_verylow :: Integer
g_base :: Integer
g_zero :: Integer
g_access_list_storage_key :: forall n. FeeSchedule n -> n
g_access_list_address :: forall n. FeeSchedule n -> n
g_warm_storage_read :: forall n. FeeSchedule n -> n
g_cold_account_access :: forall n. FeeSchedule n -> n
g_cold_sload :: forall n. FeeSchedule n -> n
r_block :: forall n. FeeSchedule n -> n
g_fround :: forall n. FeeSchedule n -> n
g_pairing_base :: forall n. FeeSchedule n -> n
g_pairing_point :: forall n. FeeSchedule n -> n
g_ecmul :: forall n. FeeSchedule n -> n
g_ecadd :: forall n. FeeSchedule n -> n
g_quaddivisor :: forall n. FeeSchedule n -> n
g_extcodehash :: forall n. FeeSchedule n -> n
g_blockhash :: forall n. FeeSchedule n -> n
g_copy :: forall n. FeeSchedule n -> n
g_sha3word :: forall n. FeeSchedule n -> n
g_sha3 :: forall n. FeeSchedule n -> n
g_logtopic :: forall n. FeeSchedule n -> n
g_logdata :: forall n. FeeSchedule n -> n
g_log :: forall n. FeeSchedule n -> n
g_transaction :: forall n. FeeSchedule n -> n
g_txdatanonzero :: forall n. FeeSchedule n -> n
g_txdatazero :: forall n. FeeSchedule n -> n
g_txcreate :: forall n. FeeSchedule n -> n
g_memory :: forall n. FeeSchedule n -> n
g_expbyte :: forall n. FeeSchedule n -> n
g_exp :: forall n. FeeSchedule n -> n
g_newaccount :: forall n. FeeSchedule n -> n
g_callstipend :: forall n. FeeSchedule n -> n
g_callvalue :: forall n. FeeSchedule n -> n
g_call :: forall n. FeeSchedule n -> n
g_codedeposit :: forall n. FeeSchedule n -> n
g_create :: forall n. FeeSchedule n -> n
r_selfdestruct :: forall n. FeeSchedule n -> n
g_selfdestruct_newaccount :: forall n. FeeSchedule n -> n
g_selfdestruct :: forall n. FeeSchedule n -> n
r_sclear :: forall n. FeeSchedule n -> n
g_sreset :: forall n. FeeSchedule n -> n
g_sset :: forall n. FeeSchedule n -> n
g_jumpdest :: forall n. FeeSchedule n -> n
g_sload :: forall n. FeeSchedule n -> n
g_balance :: forall n. FeeSchedule n -> n
g_extcode :: forall n. FeeSchedule n -> n
g_high :: forall n. FeeSchedule n -> n
g_mid :: forall n. FeeSchedule n -> n
g_low :: forall n. FeeSchedule n -> n
g_verylow :: forall n. FeeSchedule n -> n
g_base :: forall n. FeeSchedule n -> n
g_zero :: forall n. FeeSchedule n -> n
..} = Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
-> VM -> FeeSchedule Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ( (Block -> Const (FeeSchedule Integer) Block)
-> VM -> Const (FeeSchedule Integer) VM
Lens' VM Block
block ((Block -> Const (FeeSchedule Integer) Block)
 -> VM -> Const (FeeSchedule Integer) VM)
-> ((FeeSchedule Integer
     -> Const (FeeSchedule Integer) (FeeSchedule Integer))
    -> Block -> Const (FeeSchedule Integer) Block)
-> Getting (FeeSchedule Integer) VM (FeeSchedule Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FeeSchedule Integer
 -> Const (FeeSchedule Integer) (FeeSchedule Integer))
-> Block -> Const (FeeSchedule Integer) Block
Lens' Block (FeeSchedule Integer)
schedule ) VM
oldVm

      -- Now dispatch on whether we were creating or calling,
      -- and whether we shall return, revert, or error (six cases).
      case Getting FrameContext Frame FrameContext -> Frame -> FrameContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FrameContext Frame FrameContext
Lens' Frame FrameContext
frameContext Frame
nextFrame of

        -- Were we calling?
        CallContext Addr
_ Addr
_ (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num -> Word
outOffset) (Word -> Word
forall a b. (Integral a, Num b) => a -> b
num -> Word
outSize) W256
_ Maybe Word
_ Buffer
_ Map Addr Contract
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 <- Getting [Addr] VM [Addr] -> StateT VM Identity [Addr]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM
Lens' VM TxState
tx ((TxState -> Const [Addr] TxState) -> VM -> Const [Addr] VM)
-> (([Addr] -> Const [Addr] [Addr])
    -> TxState -> Const [Addr] TxState)
-> Getting [Addr] VM [Addr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubState -> Const [Addr] SubState)
-> TxState -> Const [Addr] TxState
Lens' TxState SubState
substate ((SubState -> Const [Addr] SubState)
 -> TxState -> Const [Addr] TxState)
-> (([Addr] -> Const [Addr] [Addr])
    -> SubState -> Const [Addr] SubState)
-> ([Addr] -> Const [Addr] [Addr])
-> TxState
-> Const [Addr] TxState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Addr] -> Const [Addr] [Addr])
-> SubState -> Const [Addr] SubState
Lens' SubState [Addr]
touchedAccounts)

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

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

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

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

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

          case FrameResult
how of
            -- Case 4: Returning during a creation?
            FrameReturned Buffer
output -> do
                Addr -> ContractCode -> EVM ()
replaceCode Addr
createe (Buffer -> ContractCode
RuntimeCode Buffer
output)
                ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
returndata) Buffer
forall a. Monoid a => a
mempty
                EVM ()
reclaimRemainingGasAllowance
                Word -> EVM ()
push (Addr -> Word
forall a b. (Integral a, Num b) => a -> b
num Addr
createe)

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

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


-- * Memory helpers

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

accessMemoryRange
  :: FeeSchedule Integer
  -> Word
  -> Word
  -> EVM ()
  -> EVM ()
accessMemoryRange :: FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
_ Word
_ Word
0 EVM ()
continue = EVM ()
continue
accessMemoryRange FeeSchedule Integer
fees Word
f Word
l EVM ()
continue =
  if Word
f Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
l Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
l
    then Error -> EVM ()
vmError Error
IllegalOverflow
    else FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessUnboundedMemoryRange FeeSchedule Integer
fees Word
f Word
l EVM ()
continue

accessMemoryWord
  :: FeeSchedule Integer -> Word -> EVM () -> EVM ()
accessMemoryWord :: FeeSchedule Integer -> Word -> EVM () -> EVM ()
accessMemoryWord FeeSchedule Integer
fees Word
x = FeeSchedule Integer -> Word -> Word -> EVM () -> EVM ()
accessMemoryRange FeeSchedule Integer
fees Word
x Word
32

copyBytesToMemory
  :: Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory :: Buffer -> Word -> Word -> Word -> EVM ()
copyBytesToMemory Buffer
bs Word
size Word
xOffset Word
yOffset =
  if Word
size Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then EVM ()
forall (m :: * -> *). Monad m => m ()
noop
  else do
    Buffer
mem <- Getting Buffer VM Buffer -> StateT VM Identity Buffer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory)
    ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory) (Buffer -> EVM ()) -> Buffer -> EVM ()
forall a b. (a -> b) -> a -> b
$
      Buffer -> Word -> Word -> Word -> Buffer -> Buffer
writeMemory Buffer
bs Word
size Word
xOffset Word
yOffset Buffer
mem

copyCallBytesToMemory
  :: Buffer -> Word -> Word -> Word -> EVM ()
copyCallBytesToMemory :: Buffer -> Word -> Word -> Word -> EVM ()
copyCallBytesToMemory Buffer
bs Word
size Word
xOffset Word
yOffset =
  if Word
size Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then EVM ()
forall (m :: * -> *). Monad m => m ()
noop
  else do
    Buffer
mem <- Getting Buffer VM Buffer -> StateT VM Identity Buffer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory)
    ASetter VM VM Buffer Buffer -> Buffer -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Buffer -> Identity Buffer)
    -> FrameState -> Identity FrameState)
-> ASetter VM VM Buffer Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> FrameState -> Identity FrameState
Lens' FrameState Buffer
memory) (Buffer -> EVM ()) -> Buffer -> EVM ()
forall a b. (a -> b) -> a -> b
$
      Buffer -> Word -> Word -> Word -> Buffer -> Buffer
writeMemory Buffer
bs (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
size (Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Buffer -> Int
len Buffer
bs))) Word
xOffset Word
yOffset Buffer
mem

readMemory :: Word -> Word -> VM -> Buffer
readMemory :: Word -> Word -> VM -> Buffer
readMemory Word
offset Word
size VM
vm = Int -> Int -> Buffer -> Buffer
sliceWithZero (Word -> Int
forall a b. (Integral a, Num b) => a -> b
num Word
offset) (Word -> Int
forall a b. (Integral a, Num b) => a -> b
num Word
size) (Getting Buffer VM Buffer -> VM -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
memory) VM
vm)

word256At
  :: Functor f
  => Word -> (SymWord -> f (SymWord))
  -> Buffer -> f Buffer
word256At :: Word -> (SymWord -> f SymWord) -> Buffer -> f Buffer
word256At Word
i = (Buffer -> SymWord)
-> (Buffer -> SymWord -> Buffer)
-> Lens Buffer Buffer SymWord SymWord
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Buffer -> SymWord
getter Buffer -> SymWord -> Buffer
setter where
  getter :: Buffer -> SymWord
getter = Word -> Buffer -> SymWord
EVM.Symbolic.readMemoryWord Word
i
  setter :: Buffer -> SymWord -> Buffer
setter Buffer
m SymWord
x = Word -> SymWord -> Buffer -> Buffer
setMemoryWord Word
i SymWord
x Buffer
m

-- * Tracing

withTraceLocation
  :: (MonadState VM m) => TraceData -> m Trace
withTraceLocation :: TraceData -> m Trace
withTraceLocation TraceData
x = do
  VM
vm <- m VM
forall s (m :: * -> *). MonadState s m => m s
get
  let
    Just Contract
this =
      VM -> Maybe Contract
currentContract VM
vm
  Trace -> m Trace
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace :: Int -> Contract -> TraceData -> Trace
Trace
    { _traceData :: TraceData
_traceData = TraceData
x
    , _traceContract :: Contract
_traceContract = Contract
this
    , _traceOpIx :: Int
_traceOpIx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Getting (Vector Int) Contract (Vector Int)
-> Contract -> Vector Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Vector Int) Contract (Vector Int)
Lens' Contract (Vector Int)
opIxMap Contract
this) Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
Vector.!? (Getting Int VM Int -> VM -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) VM
vm)
    }

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

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

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

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

traceForest :: VM -> Forest Trace
traceForest :: VM -> Forest Trace
traceForest = Getting (Forest Trace) VM (Forest Trace) -> VM -> Forest Trace
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TreePos Empty Trace -> Const (Forest Trace) (TreePos Empty Trace))
-> VM -> Const (Forest Trace) VM
Lens' VM (TreePos Empty Trace)
traces ((TreePos Empty Trace
  -> Const (Forest Trace) (TreePos Empty Trace))
 -> VM -> Const (Forest Trace) VM)
-> ((Forest Trace -> Const (Forest Trace) (Forest Trace))
    -> TreePos Empty Trace
    -> Const (Forest Trace) (TreePos Empty Trace))
-> Getting (Forest Trace) VM (Forest Trace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TreePos Empty Trace -> Forest Trace)
-> (Forest Trace -> Const (Forest Trace) (Forest Trace))
-> TreePos Empty Trace
-> Const (Forest Trace) (TreePos Empty Trace)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to TreePos Empty Trace -> Forest Trace
forall a. TreePos Empty a -> Forest a
zipperRootForest)

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

-- * Stack manipulation

push :: Word -> EVM ()
push :: Word -> EVM ()
push = SymWord -> EVM ()
pushSym (SymWord -> EVM ()) -> (Word -> SymWord) -> Word -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> SymWord
w256lit (W256 -> SymWord) -> (Word -> W256) -> Word -> SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> W256
forall a b. (Integral a, Num b) => a -> b
num

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


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

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

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

-- * Bytecode data functions

checkJump :: (Integral n) => n -> [SymWord] -> EVM ()
checkJump :: n -> [SymWord] -> EVM ()
checkJump n
x [SymWord]
xs = do
  Buffer
theCode <- Getting Buffer VM Buffer -> StateT VM Identity Buffer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
code)
  Addr
self <- Getting Addr VM Addr -> StateT VM Identity Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
codeContract)
  Vector (Int, Op)
theCodeOps <- Getting (Vector (Int, Op)) VM (Vector (Int, Op))
-> StateT VM Identity (Vector (Int, Op))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Vector (Int, Op)) Env)
-> VM -> Const (Vector (Int, Op)) VM
Lens' VM Env
env ((Env -> Const (Vector (Int, Op)) Env)
 -> VM -> Const (Vector (Int, Op)) VM)
-> ((Vector (Int, Op)
     -> Const (Vector (Int, Op)) (Vector (Int, Op)))
    -> Env -> Const (Vector (Int, Op)) Env)
-> Getting (Vector (Int, Op)) VM (Vector (Int, Op))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Vector (Int, Op)) (Map Addr Contract))
-> Env -> Const (Vector (Int, Op)) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract
  -> Const (Vector (Int, Op)) (Map Addr Contract))
 -> Env -> Const (Vector (Int, Op)) Env)
-> ((Vector (Int, Op)
     -> Const (Vector (Int, Op)) (Vector (Int, Op)))
    -> Map Addr Contract
    -> Const (Vector (Int, Op)) (Map Addr Contract))
-> (Vector (Int, Op)
    -> Const (Vector (Int, Op)) (Vector (Int, Op)))
-> Env
-> Const (Vector (Int, Op)) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
self ((Contract -> Const (Vector (Int, Op)) Contract)
 -> Map Addr Contract
 -> Const (Vector (Int, Op)) (Map Addr Contract))
-> ((Vector (Int, Op)
     -> Const (Vector (Int, Op)) (Vector (Int, Op)))
    -> Contract -> Const (Vector (Int, Op)) Contract)
-> (Vector (Int, Op)
    -> Const (Vector (Int, Op)) (Vector (Int, Op)))
-> Map Addr Contract
-> Const (Vector (Int, Op)) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (Int, Op) -> Const (Vector (Int, Op)) (Vector (Int, Op)))
-> Contract -> Const (Vector (Int, Op)) Contract
Lens' Contract (Vector (Int, Op))
codeOps)
  Vector Int
theOpIxMap <- Getting (Vector Int) VM (Vector Int)
-> StateT VM Identity (Vector Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Env -> Const (Vector Int) Env) -> VM -> Const (Vector Int) VM
Lens' VM Env
env ((Env -> Const (Vector Int) Env) -> VM -> Const (Vector Int) VM)
-> ((Vector Int -> Const (Vector Int) (Vector Int))
    -> Env -> Const (Vector Int) Env)
-> Getting (Vector Int) VM (Vector Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Const (Vector Int) (Map Addr Contract))
-> Env -> Const (Vector Int) Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Const (Vector Int) (Map Addr Contract))
 -> Env -> Const (Vector Int) Env)
-> ((Vector Int -> Const (Vector Int) (Vector Int))
    -> Map Addr Contract -> Const (Vector Int) (Map Addr Contract))
-> (Vector Int -> Const (Vector Int) (Vector Int))
-> Env
-> Const (Vector Int) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
self ((Contract -> Const (Vector Int) Contract)
 -> Map Addr Contract -> Const (Vector Int) (Map Addr Contract))
-> Getting (Vector Int) Contract (Vector Int)
-> (Vector Int -> Const (Vector Int) (Vector Int))
-> Map Addr Contract
-> Const (Vector Int) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Vector Int) Contract (Vector Int)
Lens' Contract (Vector Int)
opIxMap)
  if n
x n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> n
forall a b. (Integral a, Num b) => a -> b
num (Buffer -> Int
len Buffer
theCode) Bool -> Bool -> Bool
&& Word8
0x5b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe (String -> Word8
forall a. HasCallStack => String -> a
error String
"tried to jump to symbolic code location") (Maybe Word8 -> Word8) -> Maybe Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ SBV Word8 -> Maybe Word8
forall a. SymVal a => SBV a -> Maybe a
unliteral (SBV Word8 -> Maybe Word8) -> SBV Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Int -> Buffer -> SBV Word8
EVM.Symbolic.index (n -> Int
forall a b. (Integral a, Num b) => a -> b
num n
x) Buffer
theCode)
    then
      if Op
OpJumpdest Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Op) -> Op
forall a b. (a, b) -> b
snd (Vector (Int, Op)
theCodeOps Vector (Int, Op) -> Int -> (Int, Op)
forall a. Vector a -> Int -> a
RegularVector.! (Vector Int
theOpIxMap Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
Vector.! n -> Int
forall a b. (Integral a, Num b) => a -> b
num n
x))
      then do
        (FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> (([SymWord] -> Identity [SymWord])
    -> FrameState -> Identity FrameState)
-> ASetter VM VM [SymWord] [SymWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymWord] -> Identity [SymWord])
-> FrameState -> Identity FrameState
Lens' FrameState [SymWord]
stack ASetter VM VM [SymWord] [SymWord] -> [SymWord] -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [SymWord]
xs
        (FrameState -> Identity FrameState) -> VM -> Identity VM
Lens' VM FrameState
state ((FrameState -> Identity FrameState) -> VM -> Identity VM)
-> ((Int -> Identity Int) -> FrameState -> Identity FrameState)
-> ASetter VM VM Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> FrameState -> Identity FrameState
Lens' FrameState Int
pc ASetter VM VM Int Int -> Int -> EVM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= n -> Int
forall a b. (Integral a, Num b) => a -> b
num n
x
      else
        Error -> EVM ()
vmError Error
BadJumpDestination
    else Error -> EVM ()
vmError Error
BadJumpDestination

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

-- Index 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 :: Buffer -> Vector Int
mkOpIxMap :: Buffer -> Vector Int
mkOpIxMap Buffer
xs = (forall s. ST s (MVector s Int)) -> Vector Int
forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
Vector.create ((forall s. ST s (MVector s Int)) -> Vector Int)
-> (forall s. ST s (MVector s Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
Vector.new (Buffer -> Int
len Buffer
xs) ST s (MVector s Int)
-> (MVector s Int -> ST s (MVector s Int)) -> ST s (MVector s Int)
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.
  case Buffer
xs of
    ConcreteBuffer ByteString
xs' ->
      let (Word8
_, Int
_, Int
_, ST s ()
m) =
            ((Word8, Int, Int, ST s ()) -> Word8 -> (Word8, Int, Int, ST s ()))
-> (Word8, Int, Int, ST s ())
-> ByteString
-> (Word8, Int, Int, ST s ())
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (MVector (PrimState (ST s)) Int
-> (Word8, Int, Int, ST s ())
-> Word8
-> (Word8, Int, Int, ST s ())
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
MVector (PrimState (ST s)) Int
v) (Word8
0 :: Word8, Int
0, Int
0, () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString
xs'
      in ST s ()
m ST s () -> ST s (MVector s Int) -> ST s (MVector s Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Int -> ST s (MVector s Int)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v
    SymbolicBuffer [SWord 8]
xs' ->
      let (WordN 8
_, Int
_, Int
_, ST s ()
m) =
            ((WordN 8, Int, Int, ST s ())
 -> SWord 8 -> (WordN 8, Int, Int, ST s ()))
-> (WordN 8, Int, Int, ST s ())
-> [SWord 8]
-> (WordN 8, Int, Int, ST s ())
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (MVector (PrimState (ST s)) Int
-> (WordN 8, Int, Int, ST s ())
-> SWord 8
-> (WordN 8, Int, Int, ST s ())
forall a (m :: * -> *) a a.
(SymVal a, Ord a, PrimMonad m, Storable a, Num a, Num a) =>
MVector (PrimState m) a
-> (a, Int, a, m a) -> SBV a -> (a, Int, a, m ())
go' MVector s Int
MVector (PrimState (ST s)) Int
v) (WordN 8
0, Int
0, Int
0, () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ([SWord 8] -> [SWord 8]
stripBytecodeMetadataSym [SWord 8]
xs')
      in ST s ()
m ST s () -> ST s (MVector s Int) -> ST s (MVector s Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Int -> ST s (MVector s Int)
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x60 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7f =
      {- Start of PUSH op. -} (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
0x60 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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 a -> a -> a
forall a. Num a => a -> a -> a
- a
1,        Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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)

    -- symbolic case
    go' :: MVector (PrimState m) a
-> (a, Int, a, m a) -> SBV a -> (a, Int, a, m ())
go' MVector (PrimState m) a
v (a
0, !Int
i, !a
j, !m a
m) SBV a
x = case SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x of
      Just a
x' -> if a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x60 Bool -> Bool -> Bool
&& a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7f
        -- start of PUSH op --
                 then (a
x' a -> a -> a
forall a. Num a => a -> a -> a
- a
0x60 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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 (a
0,             Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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 a
_ -> String -> (SBV a, Int, a, m ()) -> (a, Int, a, m ())
forall a. HasCallStack => String -> a
error String
"cannot analyze symbolic code"

      {- Start of PUSH op. -} (SBV a
x SBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
- SBV a
0x60 SBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
+ SBV a
1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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) SBV a
_ =
      {- End of PUSH op. -}   (a
0,            Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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) SBV a
_ =
      {- PUSH data. -}        (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1,        Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
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 VM -> Getting Int VM Int -> Int
forall s a. s -> Getting a s a -> a
^. (FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc
      code' :: Buffer
code' = VM
vm VM -> Getting Buffer VM Buffer -> Buffer
forall s a. s -> Getting a s a -> a
^. (FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
code
      xs :: Buffer
xs = case Buffer
code' of
        ConcreteBuffer ByteString
xs' -> ByteString -> Buffer
ConcreteBuffer (Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        SymbolicBuffer [SWord 8]
xs' -> [SWord 8] -> Buffer
SymbolicBuffer (Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
drop Int
i [SWord 8]
xs')
      op :: Word8
op = case Buffer
xs of
        ConcreteBuffer ByteString
b -> ByteString -> Int -> Word8
BS.index ByteString
b Int
0
        SymbolicBuffer [SWord 8]
b -> WordN 8 -> FromSized (WordN 8)
forall a. FromSizedBV a => a -> FromSized a
fromSized (WordN 8 -> FromSized (WordN 8)) -> WordN 8 -> FromSized (WordN 8)
forall a b. (a -> b) -> a -> b
$ WordN 8 -> Maybe (WordN 8) -> WordN 8
forall a. a -> Maybe a -> a
fromMaybe (String -> WordN 8
forall a. HasCallStack => String -> a
error String
"unexpected symbolic code") (SWord 8 -> Maybe (WordN 8)
forall a. SymVal a => SBV a -> Maybe a
unliteral ([SWord 8]
b [SWord 8] -> Int -> SWord 8
forall a. [a] -> Int -> a
!! Int
0))
  in if (Buffer -> Int
len Buffer
code' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i)
     then Maybe Op
forall a. Maybe a
Nothing
     else Op -> Maybe Op
forall a. a -> Maybe a
Just (Word8 -> Buffer -> Op
readOp Word8
op Buffer
xs)

vmOpIx :: VM -> Maybe Int
vmOpIx :: VM -> Maybe Int
vmOpIx VM
vm =
  do Contract
self <- VM -> Maybe Contract
currentContract VM
vm
     (Getting (Vector Int) Contract (Vector Int)
-> Contract -> Vector Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Vector Int) Contract (Vector Int)
Lens' Contract (Vector Int)
opIxMap Contract
self) Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
Vector.!? (Getting Int VM Int -> VM -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Int FrameState) -> VM -> Const Int VM
Lens' VM FrameState
state ((FrameState -> Const Int FrameState) -> VM -> Const Int VM)
-> ((Int -> Const Int Int) -> FrameState -> Const Int FrameState)
-> Getting Int VM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> FrameState -> Const Int FrameState
Lens' FrameState Int
pc) VM
vm)

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

readOp :: Word8 -> Buffer -> Op
readOp :: Word8 -> Buffer -> Op
readOp Word8
x Buffer
_  | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x8f = Word8 -> Op
OpDup (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1)
readOp Word8
x Buffer
_  | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x90 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x9f = Word8 -> Op
OpSwap (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x90 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1)
readOp Word8
x Buffer
_  | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0xa0 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0xa4 = Word8 -> Op
OpLog (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0xa0)
readOp Word8
x Buffer
xs | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7f =
  let n :: Word8
n   = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x60 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1
      xs'' :: SymWord
xs'' = case Buffer
xs of
        ConcreteBuffer ByteString
xs' -> Word -> SymWord
forall a b. (Integral a, Num b) => a -> b
num (Word -> SymWord) -> Word -> SymWord
forall a b. (a -> b) -> a -> b
$ Word -> ByteString -> Word
EVM.Concrete.readMemoryWord Word
0 (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num Word8
n) ByteString
xs'
        SymbolicBuffer [SWord 8]
xs' -> Word -> [SWord 8] -> SymWord
readSWord' Word
0 ([SWord 8] -> SymWord) -> [SWord 8] -> SymWord
forall a b. (a -> b) -> a -> b
$ Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
take (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
num Word8
n) [SWord 8]
xs'
  in SymWord -> Op
OpPush SymWord
xs''
readOp Word8
x Buffer
_ = case Word8
x of
  Word8
0x00 -> Op
OpStop
  Word8
0x01 -> Op
OpAdd
  Word8
0x02 -> Op
OpMul
  Word8
0x03 -> Op
OpSub
  Word8
0x04 -> Op
OpDiv
  Word8
0x05 -> Op
OpSdiv
  Word8
0x06 -> Op
OpMod
  Word8
0x07 -> Op
OpSmod
  Word8
0x08 -> Op
OpAddmod
  Word8
0x09 -> Op
OpMulmod
  Word8
0x0a -> Op
OpExp
  Word8
0x0b -> Op
OpSignextend
  Word8
0x10 -> Op
OpLt
  Word8
0x11 -> Op
OpGt
  Word8
0x12 -> Op
OpSlt
  Word8
0x13 -> Op
OpSgt
  Word8
0x14 -> Op
OpEq
  Word8
0x15 -> Op
OpIszero
  Word8
0x16 -> Op
OpAnd
  Word8
0x17 -> Op
OpOr
  Word8
0x18 -> Op
OpXor
  Word8
0x19 -> Op
OpNot
  Word8
0x1a -> Op
OpByte
  Word8
0x1b -> Op
OpShl
  Word8
0x1c -> Op
OpShr
  Word8
0x1d -> Op
OpSar
  Word8
0x20 -> Op
OpSha3
  Word8
0x30 -> Op
OpAddress
  Word8
0x31 -> Op
OpBalance
  Word8
0x32 -> Op
OpOrigin
  Word8
0x33 -> Op
OpCaller
  Word8
0x34 -> Op
OpCallvalue
  Word8
0x35 -> Op
OpCalldataload
  Word8
0x36 -> Op
OpCalldatasize
  Word8
0x37 -> Op
OpCalldatacopy
  Word8
0x38 -> Op
OpCodesize
  Word8
0x39 -> Op
OpCodecopy
  Word8
0x3a -> Op
OpGasprice
  Word8
0x3b -> Op
OpExtcodesize
  Word8
0x3c -> Op
OpExtcodecopy
  Word8
0x3d -> Op
OpReturndatasize
  Word8
0x3e -> Op
OpReturndatacopy
  Word8
0x3f -> Op
OpExtcodehash
  Word8
0x40 -> Op
OpBlockhash
  Word8
0x41 -> Op
OpCoinbase
  Word8
0x42 -> Op
OpTimestamp
  Word8
0x43 -> Op
OpNumber
  Word8
0x44 -> Op
OpDifficulty
  Word8
0x45 -> Op
OpGaslimit
  Word8
0x46 -> Op
OpChainid
  Word8
0x47 -> Op
OpSelfbalance
  Word8
0x50 -> Op
OpPop
  Word8
0x51 -> Op
OpMload
  Word8
0x52 -> Op
OpMstore
  Word8
0x53 -> Op
OpMstore8
  Word8
0x54 -> Op
OpSload
  Word8
0x55 -> Op
OpSstore
  Word8
0x56 -> Op
OpJump
  Word8
0x57 -> Op
OpJumpi
  Word8
0x58 -> Op
OpPc
  Word8
0x59 -> Op
OpMsize
  Word8
0x5a -> Op
OpGas
  Word8
0x5b -> Op
OpJumpdest
  Word8
0xf0 -> Op
OpCreate
  Word8
0xf1 -> Op
OpCall
  Word8
0xf2 -> Op
OpCallcode
  Word8
0xf3 -> Op
OpReturn
  Word8
0xf4 -> Op
OpDelegatecall
  Word8
0xf5 -> Op
OpCreate2
  Word8
0xfd -> Op
OpRevert
  Word8
0xfa -> Op
OpStaticcall
  Word8
0xff -> Op
OpSelfdestruct
  Word8
_    -> Word8 -> Op
OpUnknown Word8
x

mkCodeOps :: Buffer -> RegularVector.Vector (Int, Op)
mkCodeOps :: Buffer -> Vector (Int, Op)
mkCodeOps (ConcreteBuffer ByteString
bytes) = [(Int, Op)] -> Vector (Int, Op)
forall a. [a] -> Vector a
RegularVector.fromList ([(Int, Op)] -> Vector (Int, Op))
-> (Seq (Int, Op) -> [(Int, Op)])
-> Seq (Int, Op)
-> Vector (Int, Op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Int, Op) -> [(Int, Op)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, Op) -> Vector (Int, Op))
-> Seq (Int, Op) -> Vector (Int, Op)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Seq (Int, Op)
go Int
0 ByteString
bytes
  where
    go :: Int -> ByteString -> Seq (Int, Op)
go !Int
i !ByteString
xs =
      case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
xs of
        Maybe (Word8, ByteString)
Nothing ->
          Seq (Int, Op)
forall a. Monoid a => a
mempty
        Just (Word8
x, ByteString
xs') ->
          let j :: Int
j = Word8 -> Int
opSize Word8
x
          in (Int
i, Word8 -> Buffer -> Op
readOp Word8
x (ByteString -> Buffer
ConcreteBuffer ByteString
xs')) (Int, Op) -> Seq (Int, Op) -> Seq (Int, Op)
forall a. a -> Seq a -> Seq a
Seq.<| Int -> ByteString -> Seq (Int, Op)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) (Int -> ByteString -> ByteString
BS.drop Int
j ByteString
xs)
mkCodeOps (SymbolicBuffer [SWord 8]
bytes) = [(Int, Op)] -> Vector (Int, Op)
forall a. [a] -> Vector a
RegularVector.fromList ([(Int, Op)] -> Vector (Int, Op))
-> (Seq (Int, Op) -> [(Int, Op)])
-> Seq (Int, Op)
-> Vector (Int, Op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Int, Op) -> [(Int, Op)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, Op) -> Vector (Int, Op))
-> Seq (Int, Op) -> Vector (Int, Op)
forall a b. (a -> b) -> a -> b
$ Int -> [SWord 8] -> Seq (Int, Op)
go' Int
0 ([SWord 8] -> [SWord 8]
stripBytecodeMetadataSym [SWord 8]
bytes)
  where
    go' :: Int -> [SWord 8] -> Seq (Int, Op)
go' !Int
i ![SWord 8]
xs =
      case [SWord 8] -> Maybe (SWord 8, [SWord 8])
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons [SWord 8]
xs of
        Maybe (SWord 8, [SWord 8])
Nothing ->
          Seq (Int, Op)
forall a. Monoid a => a
mempty
        Just (SWord 8
x, [SWord 8]
xs') ->
          let x' :: FromSized (WordN 8)
x' = WordN 8 -> FromSized (WordN 8)
forall a. FromSizedBV a => a -> FromSized a
fromSized (WordN 8 -> FromSized (WordN 8)) -> WordN 8 -> FromSized (WordN 8)
forall a b. (a -> b) -> a -> b
$ WordN 8 -> Maybe (WordN 8) -> WordN 8
forall a. a -> Maybe a -> a
fromMaybe (String -> WordN 8
forall a. HasCallStack => String -> a
error String
"unexpected symbolic code argument") (Maybe (WordN 8) -> WordN 8) -> Maybe (WordN 8) -> WordN 8
forall a b. (a -> b) -> a -> b
$ SWord 8 -> Maybe (WordN 8)
forall a. SymVal a => SBV a -> Maybe a
unliteral SWord 8
x
              j :: Int
j = Word8 -> Int
opSize Word8
FromSized (WordN 8)
x'
          in (Int
i, Word8 -> Buffer -> Op
readOp Word8
FromSized (WordN 8)
x' ([SWord 8] -> Buffer
SymbolicBuffer [SWord 8]
xs')) (Int, Op) -> Seq (Int, Op) -> Seq (Int, Op)
forall a. a -> Seq a -> Seq a
Seq.<| Int -> [SWord 8] -> Seq (Int, Op)
go' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) (Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
drop Int
j [SWord 8]
xs)

-- * Gas cost calculation helpers

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

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

concreteModexpGasFee :: ByteString -> Integer
concreteModexpGasFee :: ByteString -> Integer
concreteModexpGasFee ByteString
input = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
200 ((Integer
multiplicationComplexity Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
iterCount) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
3)
  where (Word
lenb, Word
lene, Word
lenm) = ByteString -> (Word, Word, Word)
parseModexpLength ByteString
input
        ez :: Bool
ez = Word -> Word -> ByteString -> Bool
isZero (Word
96 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
lenb) Word
lene ByteString
input
        e' :: Word
e' = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
          Word -> Word -> ByteString -> ByteString
lazySlice (Word
96 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
lenb) (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
32 Word
lene) ByteString
input
        nwords :: Integer
        nwords :: Integer
nwords = Integer -> Integer -> Integer
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Word -> Integer) -> Word -> Integer
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
lenb Word
lenm) Integer
8
        multiplicationComplexity :: Integer
multiplicationComplexity = Integer
nwords Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
nwords
        iterCount' :: Integer
        iterCount' :: Integer
iterCount' | Word
lene Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
32 Bool -> Bool -> Bool
&& Bool
ez = Integer
0
                   | Word
lene Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
32 = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Word -> Int
forall b. FiniteBits b => b -> Int
log2 Word
e')
                   | Word
e' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
lene Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
32)
                   | Bool
otherwise = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Word -> Int
forall b. FiniteBits b => b -> Int
log2 Word
e') Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
num Word
lene Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
32)
        iterCount :: Integer
iterCount = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
iterCount' Integer
1

-- Gas cost of precompiles
costOfPrecompile :: FeeSchedule Integer -> Addr -> Buffer -> Integer
costOfPrecompile :: FeeSchedule Integer -> Addr -> Buffer -> Integer
costOfPrecompile (FeeSchedule {Integer
g_access_list_storage_key :: Integer
g_access_list_address :: Integer
g_warm_storage_read :: Integer
g_cold_account_access :: Integer
g_cold_sload :: Integer
r_block :: Integer
g_fround :: Integer
g_pairing_base :: Integer
g_pairing_point :: Integer
g_ecmul :: Integer
g_ecadd :: Integer
g_quaddivisor :: Integer
g_extcodehash :: Integer
g_blockhash :: Integer
g_copy :: Integer
g_sha3word :: Integer
g_sha3 :: Integer
g_logtopic :: Integer
g_logdata :: Integer
g_log :: Integer
g_transaction :: Integer
g_txdatanonzero :: Integer
g_txdatazero :: Integer
g_txcreate :: Integer
g_memory :: Integer
g_expbyte :: Integer
g_exp :: Integer
g_newaccount :: Integer
g_callstipend :: Integer
g_callvalue :: Integer
g_call :: Integer
g_codedeposit :: Integer
g_create :: Integer
r_selfdestruct :: Integer
g_selfdestruct_newaccount :: Integer
g_selfdestruct :: Integer
r_sclear :: Integer
g_sreset :: Integer
g_sset :: Integer
g_jumpdest :: Integer
g_sload :: Integer
g_balance :: Integer
g_extcode :: Integer
g_high :: Integer
g_mid :: Integer
g_low :: Integer
g_verylow :: Integer
g_base :: Integer
g_zero :: Integer
g_access_list_storage_key :: forall n. FeeSchedule n -> n
g_access_list_address :: forall n. FeeSchedule n -> n
g_warm_storage_read :: forall n. FeeSchedule n -> n
g_cold_account_access :: forall n. FeeSchedule n -> n
g_cold_sload :: forall n. FeeSchedule n -> n
r_block :: forall n. FeeSchedule n -> n
g_fround :: forall n. FeeSchedule n -> n
g_pairing_base :: forall n. FeeSchedule n -> n
g_pairing_point :: forall n. FeeSchedule n -> n
g_ecmul :: forall n. FeeSchedule n -> n
g_ecadd :: forall n. FeeSchedule n -> n
g_quaddivisor :: forall n. FeeSchedule n -> n
g_extcodehash :: forall n. FeeSchedule n -> n
g_blockhash :: forall n. FeeSchedule n -> n
g_copy :: forall n. FeeSchedule n -> n
g_sha3word :: forall n. FeeSchedule n -> n
g_sha3 :: forall n. FeeSchedule n -> n
g_logtopic :: forall n. FeeSchedule n -> n
g_logdata :: forall n. FeeSchedule n -> n
g_log :: forall n. FeeSchedule n -> n
g_transaction :: forall n. FeeSchedule n -> n
g_txdatanonzero :: forall n. FeeSchedule n -> n
g_txdatazero :: forall n. FeeSchedule n -> n
g_txcreate :: forall n. FeeSchedule n -> n
g_memory :: forall n. FeeSchedule n -> n
g_expbyte :: forall n. FeeSchedule n -> n
g_exp :: forall n. FeeSchedule n -> n
g_newaccount :: forall n. FeeSchedule n -> n
g_callstipend :: forall n. FeeSchedule n -> n
g_callvalue :: forall n. FeeSchedule n -> n
g_call :: forall n. FeeSchedule n -> n
g_codedeposit :: forall n. FeeSchedule n -> n
g_create :: forall n. FeeSchedule n -> n
r_selfdestruct :: forall n. FeeSchedule n -> n
g_selfdestruct_newaccount :: forall n. FeeSchedule n -> n
g_selfdestruct :: forall n. FeeSchedule n -> n
r_sclear :: forall n. FeeSchedule n -> n
g_sreset :: forall n. FeeSchedule n -> n
g_sset :: forall n. FeeSchedule n -> n
g_jumpdest :: forall n. FeeSchedule n -> n
g_sload :: forall n. FeeSchedule n -> n
g_balance :: forall n. FeeSchedule n -> n
g_extcode :: forall n. FeeSchedule n -> n
g_high :: forall n. FeeSchedule n -> n
g_mid :: forall n. FeeSchedule n -> n
g_low :: forall n. FeeSchedule n -> n
g_verylow :: forall n. FeeSchedule n -> n
g_base :: forall n. FeeSchedule n -> n
g_zero :: forall n. FeeSchedule n -> n
..}) Addr
precompileAddr Buffer
input =
  case Addr
precompileAddr of
    -- ECRECOVER
    Addr
0x1 -> Integer
3000
    -- SHA2-256
    Addr
0x2 -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (((Buffer -> Int
len Buffer
input Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
31) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
60
    -- RIPEMD-160
    Addr
0x3 -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (((Buffer -> Int
len Buffer
input Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
31) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
120) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
600
    -- IDENTITY
    Addr
0x4 -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (((Buffer -> Int
len Buffer
input Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
31) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
15
    -- MODEXP
    Addr
0x5 -> ByteString -> Integer
concreteModexpGasFee ByteString
input'
      where input' :: ByteString
input' = case Buffer
input of
               SymbolicBuffer [SWord 8]
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"unsupported: symbolic MODEXP gas cost calc"
               ConcreteBuffer ByteString
b -> ByteString
b
    -- ECADD
    Addr
0x6 -> Integer
g_ecadd
    -- ECMUL
    Addr
0x7 -> Integer
g_ecmul
    -- ECPAIRING
    Addr
0x8 -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ((Buffer -> Int
len Buffer
input) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
192) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
num Integer
g_pairing_point) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
num Integer
g_pairing_base)
    -- BLAKE2
    Addr
0x9 -> let input' :: ByteString
input' = case Buffer
input of
                         SymbolicBuffer [SWord 8]
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"unsupported: symbolic BLAKE2B gas cost calc"
                         ConcreteBuffer ByteString
b -> ByteString
b
           in Integer
g_fround Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
num (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ Word -> Word -> ByteString -> ByteString
lazySlice Word
0 Word
4 ByteString
input')
    Addr
_ -> String -> Integer
forall a. HasCallStack => String -> a
error (String
"unimplemented precompiled contract " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Addr -> String
forall a. Show a => a -> String
show Addr
precompileAddr)

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

-- * Arithmetic

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

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

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


-- * Emacs setup

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