{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ImplicitParams #-}

module EVM where

import Prelude hiding (exponent)

import Optics.Core
import Optics.State
import Optics.State.Operators
import Optics.Zoom
import Optics.Operators.Unsafe

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

import Control.Monad.State.Strict hiding (state)
import Data.Bits (FiniteBits, countLeadingZeros, finiteBitSize)
import Data.ByteArray qualified as BA
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy (fromStrict)
import Data.ByteString.Lazy qualified as LS
import Data.ByteString.Char8 qualified as Char8
import Data.Foldable (toList)
import Data.List (find)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe, fromJust)
import Data.Set (insert, member, fromList)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (unpack)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Tree
import Data.Tree.Zipper qualified as Zipper
import Data.Tuple.Curry
import Data.Typeable
import Data.Vector qualified as V
import Data.Vector.Storable qualified as SV
import Data.Vector.Storable.Mutable qualified as SV
import Data.Word (Word8, Word32, Word64)
import Witch (into, unsafeInto)

import Crypto.Hash (Digest, SHA256, RIPEMD160)
import Crypto.Hash qualified as Crypto
import Crypto.Number.ModArithmetic (expFast)

blankState :: FrameState
blankState :: FrameState
blankState = FrameState
  { $sel:contract:FrameState :: Addr
contract     = Addr
0
  , $sel:codeContract:FrameState :: Addr
codeContract = Addr
0
  , $sel:code:FrameState :: ContractCode
code         = RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
"")
  , $sel:pc:FrameState :: Int
pc           = Int
0
  , $sel:stack:FrameState :: [Expr 'EWord]
stack        = [Expr 'EWord]
forall a. Monoid a => a
mempty
  , $sel:memory:FrameState :: Expr 'Buf
memory       = Expr 'Buf
forall a. Monoid a => a
mempty
  , $sel:memorySize:FrameState :: Word64
memorySize   = Word64
0
  , $sel:calldata:FrameState :: Expr 'Buf
calldata     = Expr 'Buf
forall a. Monoid a => a
mempty
  , $sel:callvalue:FrameState :: Expr 'EWord
callvalue    = W256 -> Expr 'EWord
Lit W256
0
  , $sel:caller:FrameState :: Expr 'EWord
caller       = W256 -> Expr 'EWord
Lit W256
0
  , $sel:gas:FrameState :: Word64
gas          = Word64
0
  , $sel:returndata:FrameState :: Expr 'Buf
returndata   = Expr 'Buf
forall a. Monoid a => a
mempty
  , $sel:static:FrameState :: Bool
static       = Bool
False
  }

-- | An "external" view of a contract's bytecode, appropriate for
-- e.g. @EXTCODEHASH@.
bytecode :: Getter Contract (Expr Buf)
bytecode :: Getter Contract (Expr 'Buf)
bytecode = Optic A_Lens NoIx Contract Contract ContractCode ContractCode
#contractcode Optic A_Lens NoIx Contract Contract ContractCode ContractCode
-> Optic
     A_Getter NoIx ContractCode ContractCode (Expr 'Buf) (Expr 'Buf)
-> Getter Contract (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (ContractCode -> Expr 'Buf)
-> Optic
     A_Getter NoIx ContractCode ContractCode (Expr 'Buf) (Expr 'Buf)
forall s a. (s -> a) -> Getter s a
to ContractCode -> Expr 'Buf
f
  where f :: ContractCode -> Expr 'Buf
f (InitCode ByteString
_ Expr 'Buf
_) = Expr 'Buf
forall a. Monoid a => a
mempty
        f (RuntimeCode (ConcreteRuntimeCode ByteString
bs)) = ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
        f (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList Vector (Expr 'Byte)
ops

-- * Data accessors

currentContract :: VM -> Maybe Contract
currentContract :: VM -> Maybe Contract
currentContract VM
vm =
  Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VM
vm.state.codeContract VM
vm.env.contracts

-- * Data constructors

makeVm :: VMOpts -> VM
makeVm :: VMOpts -> VM
makeVm VMOpts
o =
  let txaccessList :: Map Addr [W256]
txaccessList = VMOpts
o.txAccessList
      txorigin :: Addr
txorigin = VMOpts
o.origin
      txtoAddr :: Addr
txtoAddr = VMOpts
o.address
      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, VMOpts
o.coinbase] [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 m a. Monoid m => (a -> m) -> [a] -> m
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
o.create then [Addr
txorigin] else [Addr
txorigin, Addr
txtoAddr]
  in
  VM
  { $sel:result:VM :: Maybe VMResult
result = Maybe VMResult
forall a. Maybe a
Nothing
  , $sel:frames:VM :: [Frame]
frames = [Frame]
forall a. Monoid a => a
mempty
  , $sel:tx:VM :: TxState
tx = TxState
    { $sel:gasprice:TxState :: W256
gasprice = VMOpts
o.gasprice
    , $sel:gaslimit:TxState :: Word64
gaslimit = VMOpts
o.gaslimit
    , $sel:priorityFee:TxState :: W256
priorityFee = VMOpts
o.priorityFee
    , $sel:origin:TxState :: Addr
origin = Addr
txorigin
    , $sel:toAddr:TxState :: Addr
toAddr = Addr
txtoAddr
    , $sel:value:TxState :: Expr 'EWord
value = VMOpts
o.value
    , $sel:substate:TxState :: SubState
substate = [Addr]
-> [Addr]
-> Set Addr
-> Set (Addr, W256)
-> [(Addr, Word64)]
-> SubState
SubState [Addr]
forall a. Monoid a => a
mempty [Addr]
touched Set Addr
initialAccessedAddrs Set (Addr, W256)
initialAccessedStorageKeys [(Addr, Word64)]
forall a. Monoid a => a
mempty
    --, _accessList = txaccessList
    , $sel:isCreate:TxState :: Bool
isCreate = VMOpts
o.create
    , $sel:txReversion:TxState :: Map Addr Contract
txReversion = [(Addr, Contract)] -> Map Addr Contract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(VMOpts
o.address , VMOpts
o.contract )]
    }
  , $sel:logs:VM :: [Expr 'Log]
logs = []
  , $sel:traces:VM :: TreePos Empty Trace
traces = Forest Trace -> TreePos Empty Trace
forall a. Forest a -> TreePos Empty a
Zipper.fromForest []
  , $sel:block:VM :: Block
block = Block
    { $sel:coinbase:Block :: Addr
coinbase = VMOpts
o.coinbase
    , $sel:timestamp:Block :: Expr 'EWord
timestamp = VMOpts
o.timestamp
    , $sel:number:Block :: W256
number = VMOpts
o.number
    , $sel:prevRandao:Block :: W256
prevRandao = VMOpts
o.prevRandao
    , $sel:maxCodeSize:Block :: W256
maxCodeSize = VMOpts
o.maxCodeSize
    , $sel:gaslimit:Block :: Word64
gaslimit = VMOpts
o.blockGaslimit
    , $sel:baseFee:Block :: W256
baseFee = VMOpts
o.baseFee
    , $sel:schedule:Block :: FeeSchedule Word64
schedule = VMOpts
o.schedule
    }
  , $sel:state:VM :: FrameState
state = FrameState
    { $sel:pc:FrameState :: Int
pc = Int
0
    , $sel:stack:FrameState :: [Expr 'EWord]
stack = [Expr 'EWord]
forall a. Monoid a => a
mempty
    , $sel:memory:FrameState :: Expr 'Buf
memory = Expr 'Buf
forall a. Monoid a => a
mempty
    , $sel:memorySize:FrameState :: Word64
memorySize = Word64
0
    , $sel:code:FrameState :: ContractCode
code = VMOpts
o.contract.contractcode
    , $sel:contract:FrameState :: Addr
contract = VMOpts
o.address
    , $sel:codeContract:FrameState :: Addr
codeContract = VMOpts
o.address
    , $sel:calldata:FrameState :: Expr 'Buf
calldata = (Expr 'Buf, [Prop]) -> Expr 'Buf
forall a b. (a, b) -> a
fst VMOpts
o.calldata
    , $sel:callvalue:FrameState :: Expr 'EWord
callvalue = VMOpts
o.value
    , $sel:caller:FrameState :: Expr 'EWord
caller = VMOpts
o.caller
    , $sel:gas:FrameState :: Word64
gas = VMOpts
o.gas
    , $sel:returndata:FrameState :: Expr 'Buf
returndata = Expr 'Buf
forall a. Monoid a => a
mempty
    , $sel:static:FrameState :: Bool
static = Bool
False
    }
  , $sel:env:VM :: Env
env = Env
    { $sel:chainId:Env :: W256
chainId = VMOpts
o.chainId
    , $sel:storage:Env :: Expr 'Storage
storage = VMOpts
o.initialStorage
    , $sel:origStorage:Env :: Map W256 (Map W256 W256)
origStorage = Map W256 (Map W256 W256)
forall a. Monoid a => a
mempty
    , $sel:contracts:Env :: Map Addr Contract
contracts = [(Addr, Contract)] -> Map Addr Contract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(VMOpts
o.address, VMOpts
o.contract )]
    }
  , $sel:cache:VM :: Cache
cache = Map Addr Contract
-> Map W256 (Map W256 W256)
-> Map (CodeLocation, Int) Bool
-> Cache
Cache Map Addr Contract
forall a. Monoid a => a
mempty Map W256 (Map W256 W256)
forall a. Monoid a => a
mempty Map (CodeLocation, Int) Bool
forall a. Monoid a => a
mempty
  , $sel:burned:VM :: Word64
burned = Word64
0
  , $sel:constraints:VM :: [Prop]
constraints = (Expr 'Buf, [Prop]) -> [Prop]
forall a b. (a, b) -> b
snd VMOpts
o.calldata
  , $sel:keccakEqs:VM :: [Prop]
keccakEqs = [Prop]
forall a. Monoid a => a
mempty
  , $sel:iterations:VM :: Map CodeLocation (Int, [Expr 'EWord])
iterations = Map CodeLocation (Int, [Expr 'EWord])
forall a. Monoid a => a
mempty
  , $sel:allowFFI:VM :: Bool
allowFFI = VMOpts
o.allowFFI
  , $sel:overrideCaller:VM :: Maybe Addr
overrideCaller = Maybe Addr
forall a. Maybe a
Nothing
  }

-- | Initialize empty contract with given code
initialContract :: ContractCode -> Contract
initialContract :: ContractCode -> Contract
initialContract ContractCode
contractCode = Contract
  { $sel:contractcode:Contract :: ContractCode
contractcode = ContractCode
contractCode
  , $sel:codehash:Contract :: Expr 'EWord
codehash = ContractCode -> Expr 'EWord
hashcode ContractCode
contractCode
  , $sel:balance:Contract :: W256
balance  = W256
0
  , $sel:nonce:Contract :: W256
nonce    = if Bool
creation then W256
1 else W256
0
  , $sel:opIxMap:Contract :: Vector Int
opIxMap  = ContractCode -> Vector Int
mkOpIxMap ContractCode
contractCode
  , $sel:codeOps:Contract :: Vector (Int, GenericOp (Expr 'EWord))
codeOps  = ContractCode -> Vector (Int, GenericOp (Expr 'EWord))
mkCodeOps ContractCode
contractCode
  , $sel:external:Contract :: Bool
external = Bool
False
  } where
      creation :: Bool
creation = case ContractCode
contractCode of
        InitCode ByteString
_ Expr 'Buf
_  -> Bool
True
        RuntimeCode RuntimeCode
_ -> Bool
False

-- * Opcode dispatch (exec1)

-- | Update program counter
next :: (?op :: Word8) => EVM ()
next :: (?op::Word8) => EVM ()
next = Optic A_Lens NoIx VM VM Int Int -> (Int -> Int) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Int Int
-> Optic A_Lens NoIx VM VM Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Int 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
    -- Convenient aliases
    mem :: Expr 'Buf
mem  = VM
vm.state.memory
    stk :: [Expr 'EWord]
stk  = VM
vm.state.stack
    self :: Addr
self = VM
vm.state.contract
    this :: Contract
this = Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Contract
forall a. HasCallStack => [Char] -> a
internalError [Char]
"state contract") (Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
self VM
vm.env.contracts)

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

    doStop :: EVM ()
doStop = FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
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 = ?op::Word8
Word8
0x00 -- dummy value
    case Expr 'Buf -> Expr 'EWord
bufLength VM
vm.state.calldata of
      Lit W256
calldatasize -> do
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm.state.calldata (W256 -> Expr 'EWord
Lit W256
calldatasize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
0)
          (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
self VM
vm.state.gas W256
0 W256
calldatasize W256
0 W256
0 []
          VM
vmx <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
          case VM
vmx.state.stack of
            Expr 'EWord
x:[Expr 'EWord]
_ -> case Expr 'EWord
x of
              Lit W256
0 ->
                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
                  EvmError -> EVM ()
vmError EvmError
PrecompileFailure
              Lit W256
_ ->
                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
                  Expr 'Buf
out <- Optic' A_Lens NoIx VM (Expr 'Buf) -> StateT VM Identity (Expr 'Buf)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata)
                  FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
out)
              Expr 'EWord
e -> PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$
                     Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vmx.state.pc [Char]
"precompile returned a symbolic value" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
e])
            [Expr 'EWord]
_ ->
              EVM ()
underrun
      Expr 'EWord
e -> PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$
             Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
"cannot call precompiles with symbolic data" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
e])

  else if VM
vm.state.pc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ContractCode -> Int
opslen VM
vm.state.code
    then EVM ()
doStop

    else do
      let ?op = case VM
vm.state.code of
                  InitCode ByteString
conc Expr 'Buf
_ -> HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
conc VM
vm.state.pc
                  RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs VM
vm.state.pc
                  RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
                    Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"could not analyze symbolic code") (Maybe Word8 -> Word8) -> Maybe Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                      Expr 'Byte -> Maybe Word8
maybeLitByte (Expr 'Byte -> Maybe Word8) -> Expr 'Byte -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops Vector (Expr 'Byte) -> Int -> Expr 'Byte
forall a. Vector a -> Int -> a
V.! VM
vm.state.pc

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

        GenericOp Word8
OpPush0 -> do
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
              EVM ()
(?op::Word8) => EVM ()
next
              Expr 'EWord -> EVM ()
pushSym (W256 -> Expr 'EWord
Lit W256
0)

        OpPush Word8
n' -> do
          let n :: Int
n = Word8 -> Int
forall target source. From source target => source -> target
into Word8
n'
              !xs :: Expr 'EWord
xs = case VM
vm.state.code of
                InitCode ByteString
conc Expr 'Buf
_ -> W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> W256 -> Expr 'EWord
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
+ VM
vm.state.pc) ByteString
conc)
                RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> W256 -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VM
vm.state.pc) ByteString
bs
                RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
                  let bytes :: Vector (Expr 'Byte)
bytes = Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a. Int -> Vector a -> Vector a
V.take Int
n (Vector (Expr 'Byte) -> Vector (Expr 'Byte))
-> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a. Int -> Vector a -> Vector a
V.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VM
vm.state.pc) Vector (Expr 'Byte)
ops
                  in Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
0) (Expr 'Buf -> Expr 'EWord) -> Expr 'Buf -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList (Vector (Expr 'Byte) -> Expr 'Buf)
-> Vector (Expr 'Byte) -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
padLeft' Int
32 Vector (Expr 'Byte)
bytes
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM () -> EVM ()
burn Word64
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
              EVM ()
(?op::Word8) => EVM ()
next
              Expr 'EWord -> EVM ()
pushSym Expr 'EWord
xs

        OpDup Word8
i ->
          case Optic' An_AffineTraversal NoIx [Expr 'EWord] (Expr 'EWord)
-> [Expr 'EWord] -> Maybe (Expr 'EWord)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (Word8 -> Int
forall target source. From source target => source -> target
into Word8
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [Expr 'EWord]
stk of
            Maybe (Expr 'EWord)
Nothing -> EVM ()
underrun
            Just Expr 'EWord
y ->
              Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                Word64 -> EVM () -> EVM ()
burn Word64
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  Expr 'EWord -> EVM ()
pushSym Expr 'EWord
y

        OpSwap Word8
i ->
          if [Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
stk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Word8 -> Int
forall target source. From source target => source -> target
into Word8
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            then EVM ()
underrun
            else
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                EVM ()
(?op::Word8) => EVM ()
next
                Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT [Expr 'EWord] Identity () -> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM [Expr 'EWord]
-> StateT [Expr 'EWord] Identity c -> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (StateT [Expr 'EWord] Identity () -> EVM ())
-> StateT [Expr 'EWord] Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  Optic'
  (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord] -> StateT [Expr 'EWord] Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Expr 'EWord]
0) ([Expr 'EWord]
stk [Expr 'EWord]
-> Optic'
     An_AffineTraversal NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord]
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (Word8 -> Int
forall target source. From source target => source -> target
into Word8
i))
                  Optic'
  (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord] -> StateT [Expr 'EWord] Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (Word8 -> Index [Expr 'EWord]
forall target source. From source target => source -> target
into Word8
i)) ([Expr 'EWord]
stk [Expr 'EWord]
-> Optic'
     An_AffineTraversal NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord]
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) NoIx [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Int
Index [Expr 'EWord]
0)

        OpLog Word8
n ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
xs) ->
              if [Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Word8 -> Int
forall target source. From source target => source -> target
into Word8
n)
              then EVM ()
underrun
              else
                (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xOffset', Expr 'EWord
xSize') [Char]
"LOG" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) -> do
                    let ([Expr 'EWord]
topics, [Expr 'EWord]
xs') = Int -> [Expr 'EWord] -> ([Expr 'EWord], [Expr 'EWord])
forall a. Int -> [a] -> ([a], [a])
splitAt (Word8 -> Int
forall target source. From source target => source -> target
into Word8
n) [Expr 'EWord]
xs
                        bytes :: Expr 'Buf
bytes         = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                        logs' :: [Expr 'Log]
logs'         = (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> Expr 'Log
LogEntry (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'Buf
bytes [Expr 'EWord]
topics) Expr 'Log -> [Expr 'Log] -> [Expr 'Log]
forall a. a -> [a] -> [a]
: VM
vm.logs
                    Word64 -> EVM () -> EVM ()
burn (Word64
g_log Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_logdata Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall target source. From source target => source -> target
into Word8
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
g_logtopic) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                      W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                        [Expr 'Log] -> EVM ()
traceTopLog [Expr 'Log]
logs'
                        EVM ()
(?op::Word8) => EVM ()
next
                        Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs'
                        Optic A_Lens NoIx VM VM [Expr 'Log] [Expr 'Log]
-> [Expr 'Log] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM [Expr 'Log] [Expr 'Log]
#logs [Expr 'Log]
logs'
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpStop -> EVM ()
doStop

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

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

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

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

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

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

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

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

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

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

        -- more accurately refered to as KECCAK
        GenericOp Word8
OpSha3 ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
xs ->
              Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
xOffset' [Char]
"sha3 offset must be concrete" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \W256
xOffset -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
xSize' [Char]
"sha3 size must be concrete" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
xSize ->
                  Word64 -> EVM () -> EVM ()
burn (Word64
g_sha3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_sha3word Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      Expr 'EWord
hash <- case Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm of
                                          ConcreteBuf ByteString
bs -> do
                                            let hash' :: W256
hash' = ByteString -> W256
keccak' ByteString
bs
                                            [Prop]
eqs <- Lens VM VM [Prop] [Prop] -> StateT VM Identity [Prop]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Lens VM VM [Prop] [Prop]
#keccakEqs
                                            Lens VM VM [Prop] [Prop] -> [Prop] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Lens VM VM [Prop] [Prop]
#keccakEqs ([Prop] -> EVM ()) -> [Prop] -> EVM ()
forall a b. (a -> b) -> a -> b
$
                                              Expr 'EWord -> Expr 'EWord -> Prop
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
PEq (W256 -> Expr 'EWord
Lit W256
hash') (Expr 'Buf -> Expr 'EWord
Keccak (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs))Prop -> [Prop] -> [Prop]
forall a. a -> [a] -> [a]
:[Prop]
eqs
                                            Expr 'EWord -> StateT VM Identity (Expr 'EWord)
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EWord -> StateT VM Identity (Expr 'EWord))
-> Expr 'EWord -> StateT VM Identity (Expr 'EWord)
forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord
Lit W256
hash'
                                          Expr 'Buf
buf -> Expr 'EWord -> StateT VM Identity (Expr 'EWord)
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EWord -> StateT VM Identity (Expr 'EWord))
-> Expr 'EWord -> StateT VM Identity (Expr 'EWord)
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
Keccak Expr 'Buf
buf
                      EVM ()
(?op::Word8) => EVM ()
next
                      Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (Expr 'EWord
hash Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpAddress ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Addr -> W256
forall target source. From source target => source -> target
into Addr
self))

        GenericOp Word8
OpBalance ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' [Char]
"BALANCE" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Addr -> EVM () -> EVM ()
accessAndBurn (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
x) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
x) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                  EVM ()
(?op::Word8) => EVM ()
next
                  Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                  W256 -> EVM ()
push Contract
c.balance
            [] ->
              EVM ()
underrun

        GenericOp Word8
OpOrigin ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Addr -> W256
forall target source. From source target => source -> target
into VM
vm.tx.origin)

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

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

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

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

        GenericOp Word8
OpCalldatacopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xTo':Expr 'EWord
xFrom:Expr 'EWord
xSize':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xTo', Expr 'EWord
xSize') [Char]
"CALLDATACOPY" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \(W256
xTo, W256
xSize) ->
                  Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xTo W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      EVM ()
(?op::Word8) => EVM ()
next
                      Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                      Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm.state.calldata Expr 'EWord
xSize' Expr 'EWord
xFrom Expr 'EWord
xTo'
            [Expr 'EWord]
_ -> EVM ()
underrun

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

        GenericOp Word8
OpCodecopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
memOffset':Expr 'EWord
codeOffset:Expr 'EWord
n':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
memOffset', Expr 'EWord
n') [Char]
"CODECOPY" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \(W256
memOffset,W256
n) -> do
                  case W256 -> Maybe Word64
toWord64 W256
n of
                    Maybe Word64
Nothing -> EvmError -> EVM ()
vmError EvmError
IllegalOverflow
                    Just Word64
n'' ->
                      if Word64
n'' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= ( (Word64
forall a. Bounded a => a
maxBound :: Word64) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
g_verylow ) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
32 then
                        Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
n) Word64
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                          W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
memOffset W256
n (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                            EVM ()
(?op::Word8) => EVM ()
next
                            Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ContractCode -> Expr 'Buf
toBuf VM
vm.state.code) Expr 'EWord
n' Expr 'EWord
codeOffset Expr 'EWord
memOffset'
                      else EvmError -> EVM ()
vmError EvmError
IllegalOverflow
            [Expr 'EWord]
_ -> EVM ()
underrun

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

        GenericOp Word8
OpExtcodesize ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':[Expr 'EWord]
xs -> case Expr 'EWord
x' of
              Lit W256
x -> if W256
x W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== Addr -> W256
forall target source. From source target => source -> target
into Addr
cheatCode
                then do
                  EVM ()
(?op::Word8) => EVM ()
next
                  Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                  Expr 'EWord -> EVM ()
pushSym (W256 -> Expr 'EWord
Lit W256
1)
                else
                  Addr -> EVM () -> EVM ()
accessAndBurn (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
x) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
x) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                      EVM ()
(?op::Word8) => EVM ()
next
                      Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                      Expr 'EWord -> EVM ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength (Getter Contract (Expr 'Buf) -> Contract -> Expr 'Buf
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Expr 'Buf)
bytecode Contract
c))
              Expr 'EWord
_ -> do
                Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                Expr 'EWord -> EVM ()
pushSym (Expr 'EWord -> Expr 'EWord
CodeSize Expr 'EWord
x')
                EVM ()
(?op::Word8) => EVM ()
next
            [] ->
              EVM ()
underrun

        GenericOp Word8
OpExtcodecopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
extAccount':Expr 'EWord
memOffset':Expr 'EWord
codeOffset:Expr 'EWord
codeSize':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
extAccount', Expr 'EWord
memOffset', Expr 'EWord
codeSize') [Char]
"EXTCODECOPY" (((W256, W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
                \(W256
extAccount, W256
memOffset, W256
codeSize) -> do
                  Bool
acc <- Addr -> EVM Bool
accessAccountForGas (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
extAccount)
                  let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
                  Word64 -> EVM () -> EVM ()
burn (Word64
cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
codeSize) Word64
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
memOffset W256
codeSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                      Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
extAccount) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                        EVM ()
(?op::Word8) => EVM ()
next
                        Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                        Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (Getter Contract (Expr 'Buf) -> Contract -> Expr 'Buf
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Expr 'Buf)
bytecode Contract
c) Expr 'EWord
codeSize' Expr 'EWord
codeOffset Expr 'EWord
memOffset'
            [Expr 'EWord]
_ -> EVM ()
underrun

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

        GenericOp Word8
OpReturndatacopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xTo':Expr 'EWord
xFrom:Expr 'EWord
xSize':[Expr 'EWord]
xs -> (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xTo', Expr 'EWord
xSize') [Char]
"RETURNDATACOPY" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(W256
xTo, W256
xSize) ->
                Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64
32) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xTo W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    EVM ()
(?op::Word8) => EVM ()
next
                    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs

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

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

        GenericOp Word8
OpExtcodehash ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' [Char]
"EXTCODEHASH" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Addr -> EVM () -> EVM ()
accessAndBurn (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
x) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                EVM ()
(?op::Word8) => EVM ()
next
                Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
x) ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
c ->
                   if Contract -> Bool
accountEmpty Contract
c
                     then W256 -> EVM ()
push W256
0
                     else Expr 'EWord -> EVM ()
pushSym (Expr 'EWord -> EVM ()) -> Expr 'EWord -> EVM ()
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
keccak (Getter Contract (Expr 'Buf) -> Contract -> Expr 'Buf
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Expr 'Buf)
bytecode Contract
c)
            [] ->
              EVM ()
underrun

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

        GenericOp Word8
OpCoinbase ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Addr -> W256
forall target source. From source target => source -> target
into VM
vm.block.coinbase)

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

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

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

        GenericOp Word8
OpGaslimit ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Word64 -> W256
forall target source. From source target => source -> target
into VM
vm.block.gaslimit)

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

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

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

        GenericOp Word8
OpPop ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
_:[Expr 'EWord]
xs -> Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs)
            [Expr 'EWord]
_    -> EVM ()
underrun

        GenericOp Word8
OpMload ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' [Char]
"MLOAD" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                W256 -> EVM () -> EVM ()
accessMemoryWord W256
x (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
x) Expr 'Buf
mem Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpMstore ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':Expr 'EWord
y:[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' [Char]
"MSTORE index" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                W256 -> EVM () -> EVM ()
accessMemoryWord W256
x (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM ()
(?op::Word8) => EVM ()
next
                  Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory) (Expr 'EWord -> Expr 'EWord -> Expr 'Buf -> Expr 'Buf
writeWord (W256 -> Expr 'EWord
Lit W256
x) Expr 'EWord
y Expr 'Buf
mem)
                  Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpMstore8 ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':Expr 'EWord
y:[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' [Char]
"MSTORE8" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
x ->
              Word64 -> EVM () -> EVM ()
burn Word64
g_verylow (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
x W256
1 (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  let yByte :: Expr 'Byte
yByte = Expr 'EWord -> Expr 'EWord -> Expr 'Byte
indexWord (W256 -> Expr 'EWord
Lit W256
31) Expr 'EWord
y
                  EVM ()
(?op::Word8) => EVM ()
next
                  Optic' A_Lens NoIx VM (Expr 'Buf)
-> (Expr 'Buf -> Expr 'Buf) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory) (Expr 'EWord -> Expr 'Byte -> Expr 'Buf -> Expr 'Buf
writeByte (W256 -> Expr 'EWord
Lit W256
x) Expr 'Byte
yByte)
                  Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpSload ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:[Expr 'EWord]
xs -> do
              Bool
acc <- Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
self Expr 'EWord
x
              let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_sload
              Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
self Expr 'EWord
x ((Expr 'EWord -> EVM ()) -> EVM ())
-> (Expr 'EWord -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
y -> do
                  EVM ()
(?op::Word8) => EVM ()
next
                  Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (Expr 'EWord
yExpr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
:[Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpSstore ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:Expr 'EWord
new:[Expr 'EWord]
xs ->
              Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
self Expr 'EWord
x ((Expr 'EWord -> EVM ()) -> EVM ())
-> (Expr 'EWord -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
current -> do
                Word64
availableGas <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas)

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

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

                  Bool
acc <- Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
self Expr 'EWord
x
                  let cold_storage_cost :: Word64
cold_storage_cost = if Bool
acc then Word64
0 else Word64
g_cold_sload
                  Word64 -> EVM () -> EVM ()
burn (Word64
storage_cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cold_storage_cost) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    EVM ()
(?op::Word8) => EVM ()
next
                    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                    Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'EWord
x Expr 'EWord
new)

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

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

        GenericOp Word8
OpJumpi -> do
          case [Expr 'EWord]
stk of
            (Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs) -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x [Char]
"JUMPI: symbolic jumpdest" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
x' ->
                Word64 -> EVM () -> EVM ()
burn Word64
g_high (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  let jump :: Bool -> EVM ()
                      jump :: Bool -> EVM ()
jump Bool
False = Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EVM ()
(?op::Word8) => EVM ()
next
                      jump Bool
_    = case W256 -> Maybe Int
toInt W256
x' of
                        Maybe Int
Nothing -> EvmError -> EVM ()
vmError EvmError
BadJumpDestination
                        Just Int
i -> Int -> [Expr 'EWord] -> EVM ()
checkJump Int
i [Expr 'EWord]
xs
                  in do
                    CodeLocation
loc <- EVM CodeLocation
codeloc
                    CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc Expr 'EWord
y Bool -> EVM ()
jump
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpPc ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto VM
vm.state.pc)

        GenericOp Word8
OpMsize ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Word64 -> W256
forall target source. From source target => source -> target
into VM
vm.state.memorySize)

        GenericOp Word8
OpGas ->
          Int -> EVM () -> EVM ()
limitStack Int
1 (EVM () -> EVM ()) -> (EVM () -> EVM ()) -> EVM () -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
            EVM ()
(?op::Word8) => EVM ()
next EVM () -> EVM () -> EVM ()
forall a b.
StateT VM Identity a
-> StateT VM Identity b -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM ()
push (Word64 -> W256
forall target source. From source target => source -> target
into (VM
vm.state.gas Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
g_base))

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

        GenericOp Word8
OpExp ->
          -- NOTE: this can be done symbolically using unrolling like this:
          --       https://hackage.haskell.org/package/sbv-9.0/docs/src/Data.SBV.Core.Model.html#.%5E
          --       However, it requires symbolic gas, since the gas depends on the exponent
          case [Expr 'EWord]
stk of
            Expr 'EWord
base:Expr 'EWord
exponent':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
exponent' [Char]
"EXP: symbolic exponent" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
exponent ->
              let cost :: Word64
cost = if W256
exponent W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0
                         then Word64
g_exp
                         else Word64
g_exp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_expbyte Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (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
+ W256 -> Int
forall b. FiniteBits b => b -> Int
log2 W256
exponent) Int
8)
              in Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                EVM ()
(?op::Word8) => EVM ()
next
                (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.exp Expr 'EWord
base Expr 'EWord
exponent' Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM ()
underrun

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

        GenericOp Word8
OpCreate ->
          EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            Expr 'EWord
xValue':Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
xs -> (Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
xValue', Expr 'EWord
xOffset', Expr 'EWord
xSize') [Char]
"CREATE" (((W256, W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(W256
xValue, W256
xOffset, W256
xSize) -> do
                W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  Word64
availableGas <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas)
                  let
                    newAddr :: Addr
newAddr = Addr -> W256 -> Addr
createAddress Addr
self Contract
this.nonce
                    (Word64
cost, Word64
gas') = FeeSchedule Word64 -> Word64 -> W256 -> Bool -> (Word64, Word64)
costOfCreate FeeSchedule Word64
fees Word64
availableGas W256
xSize Bool
False
                  Bool
_ <- Addr -> EVM Bool
accessAccountForGas Addr
newAddr
                  Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    let initCode :: Expr 'Buf
initCode = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                    (?op::Word8) =>
Addr
-> Contract
-> W256
-> Word64
-> W256
-> [Expr 'EWord]
-> Addr
-> Expr 'Buf
-> EVM ()
Addr
-> Contract
-> W256
-> Word64
-> W256
-> [Expr 'EWord]
-> Addr
-> Expr 'Buf
-> EVM ()
create Addr
self Contract
this W256
xSize Word64
gas' W256
xValue [Expr 'EWord]
xs Addr
newAddr Expr 'Buf
initCode
            [Expr 'EWord]
_ -> EVM ()
underrun

        GenericOp Word8
OpCall ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas':Expr 'EWord
xTo:Expr 'EWord
xValue':Expr 'EWord
xInOffset':Expr 'EWord
xInSize':Expr 'EWord
xOutOffset':Expr 'EWord
xOutSize':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
 Expr 'EWord)
-> [Char]
-> ((W256, W256, W256, W256, W256, W256) -> EVM ())
-> EVM ()
forceConcrete6 (Expr 'EWord
xGas', Expr 'EWord
xValue', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') [Char]
"CALL" (((W256, W256, W256, W256, W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(W256
xGas, W256
xValue, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
                (if W256
xValue W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
0 then EVM () -> EVM ()
notStatic else EVM () -> EVM ()
forall a. a -> a
id) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                  (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xGas) Expr 'EWord
xTo Expr 'EWord
xTo W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
callee -> do
                    let from' :: Addr
from' = Addr -> Maybe Addr -> Addr
forall a. a -> Maybe a -> a
fromMaybe Addr
self VM
vm.overrideCaller
                    Optic A_Lens NoIx VM VM FrameState FrameState
-> StateT FrameState Identity () -> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM FrameState
-> StateT FrameState Identity c -> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic A_Lens NoIx VM VM FrameState FrameState
#state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                      Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
                      Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#caller (Addr -> Expr 'EWord
litAddr Addr
from')
                      Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Addr -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract Addr
callee
                    Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
-> Maybe Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
#overrideCaller Maybe Addr
forall a. Maybe a
Nothing
                    Addr -> EVM ()
touchAccount Addr
from'
                    Addr -> EVM ()
touchAccount Addr
callee
                    Addr -> Addr -> W256 -> EVM ()
transfer Addr
from' Addr
callee W256
xValue
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpCallcode ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas':Expr 'EWord
xTo:Expr 'EWord
xValue':Expr 'EWord
xInOffset':Expr 'EWord
xInSize':Expr 'EWord
xOutOffset':Expr 'EWord
xOutSize':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
 Expr 'EWord)
-> [Char]
-> ((W256, W256, W256, W256, W256, W256) -> EVM ())
-> EVM ()
forceConcrete6 (Expr 'EWord
xGas', Expr 'EWord
xValue', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') [Char]
"CALLCODE" (((W256, W256, W256, W256, W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(W256
xGas, W256
xValue, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
                (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xGas) Expr 'EWord
xTo (Addr -> Expr 'EWord
litAddr Addr
self) W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
_ -> do
                  Optic A_Lens NoIx VM VM FrameState FrameState
-> StateT FrameState Identity () -> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM FrameState
-> StateT FrameState Identity c -> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic A_Lens NoIx VM VM FrameState FrameState
#state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
                    Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#caller (Expr 'EWord -> StateT FrameState Identity ())
-> Expr 'EWord -> StateT FrameState Identity ()
forall a b. (a -> b) -> a -> b
$ Addr -> Expr 'EWord
litAddr (Addr -> Expr 'EWord) -> Addr -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Addr -> Maybe Addr -> Addr
forall a. a -> Maybe a -> a
fromMaybe Addr
self VM
vm.overrideCaller
                  Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
-> Maybe Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
#overrideCaller Maybe Addr
forall a. Maybe a
Nothing
                  Addr -> EVM ()
touchAccount Addr
self
            [Expr 'EWord]
_ ->
              EVM ()
underrun

        GenericOp Word8
OpReturn ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
_ -> (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xOffset', Expr 'EWord
xSize') [Char]
"RETURN" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) ->
              W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                let
                  output :: Expr 'Buf
output = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
                  codesize :: W256
codesize = W256 -> Maybe W256 -> W256
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> W256
forall a. HasCallStack => [Char] -> a
internalError [Char]
"processing opcode RETURN. Cannot return dynamically sized abstract data")
                               (Maybe W256 -> W256)
-> (Expr 'Buf -> Maybe W256) -> Expr 'Buf -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> Maybe W256
maybeLitWord (Expr 'EWord -> Maybe W256)
-> (Expr 'Buf -> Expr 'EWord) -> Expr 'Buf -> Maybe W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> Expr 'EWord
bufLength (Expr 'Buf -> W256) -> Expr 'Buf -> W256
forall a b. (a -> b) -> a -> b
$ Expr 'Buf
output
                  maxsize :: W256
maxsize = VM
vm.block.maxCodeSize
                  creation :: Bool
creation = case VM
vm.frames of
                    [] -> VM
vm.tx.isCreate
                    Frame
frame:[Frame]
_ -> case Frame
frame.context of
                       CreationContext {} -> Bool
True
                       CallContext {} -> Bool
False
                if Bool
creation
                then
                  if W256
codesize W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
maxsize
                  then
                    FrameResult -> EVM ()
finishFrame (EvmError -> FrameResult
FrameErrored (W256 -> W256 -> EvmError
MaxCodeSizeExceeded W256
maxsize W256
codesize))
                  else do
                    let frameReturned :: EVM ()
frameReturned = Word64 -> EVM () -> EVM ()
burn (Word64
g_codedeposit Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
codesize) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
                                          FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
                        frameErrored :: EVM ()
frameErrored = FrameResult -> EVM ()
finishFrame (FrameResult -> EVM ()) -> FrameResult -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> FrameResult
FrameErrored EvmError
InvalidFormat
                    case Expr 'EWord -> Expr 'Buf -> Expr 'Byte
readByte (W256 -> Expr 'EWord
Lit W256
0) Expr 'Buf
output of
                      LitByte Word8
0xef -> EVM ()
frameErrored
                      LitByte Word8
_ -> EVM ()
frameReturned
                      Expr 'Byte
y -> do
                        CodeLocation
loc <- EVM CodeLocation
codeloc
                        CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc (Expr 'Byte -> Expr 'Byte -> Expr 'EWord
Expr.eqByte Expr 'Byte
y (Word8 -> Expr 'Byte
LitByte Word8
0xef)) ((Bool -> EVM ()) -> EVM ()) -> (Bool -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \case
                          Bool
True -> EVM ()
frameErrored
                          Bool
False -> EVM ()
frameReturned
                else
                   FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
            [Expr 'EWord]
_ -> EVM ()
underrun

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

        GenericOp Word8
OpCreate2 -> EVM () -> EVM ()
notStatic (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            Expr 'EWord
xValue':Expr 'EWord
xOffset':Expr 'EWord
xSize':Expr 'EWord
xSalt':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete4 (Expr 'EWord
xValue', Expr 'EWord
xOffset', Expr 'EWord
xSize', Expr 'EWord
xSalt') [Char]
"CREATE2" (((W256, W256, W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(W256
xValue, W256
xOffset, W256
xSize, W256
xSalt) ->
                W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  Word64
availableGas <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas)

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

        GenericOp Word8
OpStaticcall ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas':Expr 'EWord
xTo:Expr 'EWord
xInOffset':Expr 'EWord
xInSize':Expr 'EWord
xOutOffset':Expr 'EWord
xOutSize':[Expr 'EWord]
xs ->
              (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 (Expr 'EWord
xGas', Expr 'EWord
xInOffset', Expr 'EWord
xInSize', Expr 'EWord
xOutOffset', Expr 'EWord
xOutSize') [Char]
"STATICCALL" (((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
              \(W256
xGas, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) -> do
                (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xGas) Expr 'EWord
xTo Expr 'EWord
xTo W256
0 W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs ((Addr -> EVM ()) -> EVM ()) -> (Addr -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Addr
callee -> do
                  Optic A_Lens NoIx VM VM FrameState FrameState
-> StateT FrameState Identity () -> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM FrameState
-> StateT FrameState Identity c -> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic A_Lens NoIx VM VM FrameState FrameState
#state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#callvalue (W256 -> Expr 'EWord
Lit W256
0)
                    Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#caller (Expr 'EWord -> StateT FrameState Identity ())
-> Expr 'EWord -> StateT FrameState Identity ()
forall a b. (a -> b) -> a -> b
$ Addr -> Expr 'EWord
litAddr (Addr -> Expr 'EWord) -> Addr -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Addr -> Maybe Addr -> Addr
forall a. a -> Maybe a -> a
fromMaybe Addr
self (VM
vm.overrideCaller)
                    Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Addr -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract Addr
callee
                    Optic A_Lens NoIx FrameState FrameState Bool Bool
-> Bool -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Bool Bool
#static Bool
True
                  Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
-> Maybe Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
#overrideCaller Maybe Addr
forall a. Maybe a
Nothing
                  Addr -> EVM ()
touchAccount Addr
self
                  Addr -> EVM ()
touchAccount Addr
callee
            [Expr 'EWord]
_ ->
              EVM ()
underrun

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

                   if W256
funds W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
/= W256
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 % #contracts % ix xTo % #balance %= (+ funds)
                          assign (#env % #contracts % ix self % #balance) 0
                          doStop
                   else EVM ()
doStop

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

        OpUnknown Word8
xxx ->
          EvmError -> EVM ()
vmError (EvmError -> EVM ()) -> EvmError -> EVM ()
forall a b. (a -> b) -> a -> b
$ Word8 -> EvmError
UnrecognizedOpcode Word8
xxx

transfer :: Addr -> Addr -> W256 -> EVM ()
transfer :: Addr -> Addr -> W256 -> EVM ()
transfer Addr
_ Addr
_ W256
0 = () -> EVM ()
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
transfer Addr
xFrom Addr
xTo W256
xValue = do
    Maybe W256
sb <- Optic An_AffineTraversal NoIx VM VM W256 W256
-> StateT VM Identity (Maybe W256)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic An_AffineTraversal NoIx VM VM W256 W256
 -> StateT VM Identity (Maybe W256))
-> Optic An_AffineTraversal NoIx VM VM W256 W256
-> StateT VM Identity (Maybe W256)
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
xFrom Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#balance
    case Maybe W256
sb of
      Just W256
srcBal ->
        if W256
xValue W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
srcBal
        then EvmError -> EVM ()
vmError (EvmError -> EVM ()) -> EvmError -> EVM ()
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
BalanceTooLow W256
xValue W256
srcBal
        else do
          (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
xFrom Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#balance) Optic An_AffineTraversal NoIx VM VM W256 W256
-> (W256 -> W256) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (W256 -> W256 -> W256
forall a. Num a => a -> a -> a
subtract W256
xValue)
          (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
xTo Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#balance) Optic An_AffineTraversal NoIx VM VM W256 W256
-> (W256 -> W256) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
xValue)
      Maybe W256
Nothing -> EvmError -> EVM ()
vmError (EvmError -> EVM ()) -> EvmError -> EVM ()
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
BalanceTooLow W256
xValue W256
0

-- | Checks a *CALL for failure; OOG, too many callframes, memory access etc.
callChecks
  :: (?op :: Word8)
  => Contract -> Word64 -> Addr -> Addr -> W256 -> W256 -> W256 -> W256 -> W256 -> [Expr EWord]
   -- continuation with gas available for call
  -> (Word64 -> EVM ())
  -> EVM ()
callChecks :: (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
xGas Addr
xContext Addr
xTo W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs Word64 -> EVM ()
continue = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let fees :: FeeSchedule Word64
fees = VM
vm.block.schedule
  W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xInOffset W256
xInSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
    W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOutOffset W256
xOutSize (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
      Word64
availableGas <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas)
      let recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xContext VM
vm
      (Word64
cost, Word64
gas') <- FeeSchedule Word64
-> Bool -> W256 -> Word64 -> Word64 -> Addr -> EVM (Word64, Word64)
costOfCall FeeSchedule Word64
fees Bool
recipientExists W256
xValue Word64
availableGas Word64
xGas Addr
xTo
      Word64 -> EVM () -> EVM ()
burn (Word64
cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gas') (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
        if W256
xValue W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> Contract
this.balance
        then do
          Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
          TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace (W256 -> W256 -> EvmError
BalanceTooLow W256
xValue Contract
this.balance)
          EVM ()
(?op::Word8) => EVM ()
next
        else if [Frame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm.frames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024
             then do
               Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
               Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
               TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
CallDepthLimitReached
               EVM ()
(?op::Word8) => EVM ()
next
             else Word64 -> EVM ()
continue Word64
gas'

precompiledContract
  :: (?op :: Word8)
  => Contract
  -> Word64
  -> Addr
  -> Addr
  -> W256
  -> W256 -> W256 -> W256 -> W256
  -> [Expr EWord]
  -> EVM ()
precompiledContract :: (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
precompiledContract Contract
this Word64
xGas Addr
precompileAddr Addr
recipient W256
xValue W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs =
  (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
xGas Addr
recipient Addr
precompileAddr W256
xValue W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs ((Word64 -> EVM ()) -> EVM ()) -> (Word64 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Word64
gas' ->
  do
    (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
precompileAddr Word64
gas' W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs
    Addr
self <- Optic' A_Lens NoIx VM Addr -> StateT VM Identity Addr
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract)
    [Expr 'EWord]
stk <- Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT VM Identity [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack)
    Int
pc' <- Optic A_Lens NoIx VM VM Int Int -> StateT VM Identity Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Int Int
-> Optic A_Lens NoIx VM VM Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Int Int
#pc)
    Maybe VMResult
result' <- Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> StateT VM Identity (Maybe VMResult)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result
    case Maybe VMResult
result' of
      Maybe VMResult
Nothing -> case [Expr 'EWord]
stk of
        Expr 'EWord
x:[Expr 'EWord]
_ -> case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
x of
          Just W256
0 ->
            () -> EVM ()
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just W256
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 -> W256 -> EVM ()
transfer Addr
self Addr
recipient W256
xValue
              Addr -> EVM ()
touchAccount Addr
self
              Addr -> EVM ()
touchAccount Addr
recipient
          Maybe W256
_ -> PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc' [Char]
"unexpected return value from precompile" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
x])
        [Expr 'EWord]
_ -> EVM ()
underrun
      Maybe VMResult
_ -> () -> EVM ()
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

executePrecompile
  :: (?op :: Word8)
  => Addr
  -> Word64 -> W256 -> W256 -> W256 -> W256 -> [Expr EWord]
  -> EVM ()
executePrecompile :: (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
preCompileAddr Word64
gasCap W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs  = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let input :: Expr 'Buf
input = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit W256
inOffset) (W256 -> Expr 'EWord
Lit W256
inSize) VM
vm
      fees :: FeeSchedule Word64
fees = VM
vm.block.schedule
      cost :: Word64
cost = FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile FeeSchedule Word64
fees Addr
preCompileAddr Expr 'Buf
input
      notImplemented :: EVM ()
notImplemented = [Char] -> EVM ()
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> EVM ()) -> [Char] -> EVM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"precompile at address " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
preCompileAddr [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" not yet implemented"
      precompileFail :: EVM ()
precompileFail = Word64 -> EVM () -> EVM ()
burn (Word64
gasCap Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
cost) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                         Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                         TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
PrecompileFailure
                         EVM ()
(?op::Word8) => EVM ()
next
  if Word64
cost Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
gasCap then
    Word64 -> EVM () -> EVM ()
burn Word64
gasCap (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
      Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
      EVM ()
(?op::Word8) => EVM ()
next
  else Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$
    case Addr
preCompileAddr of
      -- ECRECOVER
      Addr
0x1 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECRECOVER" ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x1 (Int -> ByteString -> ByteString
truncpadlit Int
128 ByteString
input') Int
32 of
            Maybe ByteString
Nothing -> do
              -- return no output for invalid signature
              Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
              EVM ()
(?op::Word8) => EVM ()
next
            Just ByteString
output -> do
              Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output)
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output) (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
              EVM ()
(?op::Word8) => EVM ()
next

      -- SHA2-256
      Addr
0x2 ->
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"SHA2-256" ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          let
            hash :: Expr 'Buf
hash = ByteString -> Expr 'Buf
forall {ba}. ByteArrayAccess ba => ba -> Expr 'Buf
sha256Buf ByteString
input'
            sha256Buf :: ba -> Expr 'Buf
sha256Buf ba
x = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ba -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ba
x :: Digest SHA256)
          Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
hash
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
hash (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
          EVM ()
(?op::Word8) => EVM ()
next

      -- RIPEMD-160
      Addr
0x3 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"RIPEMD160" ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          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' = Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest RIPEMD160
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
input' :: Digest RIPEMD160)
            hash :: Expr 'Buf
hash  = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ ByteString
padding ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
hash'
          Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
hash
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
hash (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
          EVM ()
(?op::Word8) => EVM ()
next

      -- IDENTITY
      Addr
0x4 -> do
          Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
input
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
input (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
          EVM ()
(?op::Word8) => EVM ()
next

      -- MODEXP
      Addr
0x5 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"MODEXP" ((ByteString -> EVM ()) -> EVM ())
-> (ByteString -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          let
            (W256
lenb, W256
lene, W256
lenm) = ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input'

            output :: Expr 'Buf
output = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$
              if W256 -> W256 -> ByteString -> Bool
isZero (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
              then Int -> ByteString -> ByteString
truncpadlit (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
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
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
96 W256
lenb ByteString
input'
                  e :: Integer
e = ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input'
                  m :: Integer
m = ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
                in
                  Int -> ByteString -> ByteString
padLeft (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
lenm) (Integer -> ByteString
forall a. Integral a => a -> ByteString
asBE (Integer -> Integer -> Integer -> Integer
expFast Integer
b Integer
e Integer
m))
          Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
output
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
output (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
          EVM ()
(?op::Word8) => EVM ()
next

      -- ECADD
      Addr
0x6 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECADD" ((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 :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
              Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
              EVM ()
(?op::Word8) => EVM ()
next

      -- ECMUL
      Addr
0x7 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECMUL" ((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 :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
            Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            EVM ()
(?op::Word8) => EVM ()
next

      -- ECPAIRING
      Addr
0x8 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECPAIR" ((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 :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
32 ByteString
output
            Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
            EVM ()
(?op::Word8) => EVM ()
next

      -- BLAKE2
      Addr
0x9 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"BLAKE2" ((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
>= HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.last ByteString
input') of
            (Int
213, Bool
True) -> case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x9 ByteString
input' Int
64 of
              Just ByteString
output -> do
                let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
                Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
                Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
                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 :: W256 -> W256 -> ByteString -> LS.ByteString
lazySlice :: W256 -> W256 -> ByteString -> ByteString
lazySlice W256
offset W256
size ByteString
bs =
  let bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LS.take (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size) (Int64 -> ByteString -> ByteString
LS.drop (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
offset) (ByteString -> ByteString
fromStrict ByteString
bs))
  in ByteString
bs' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int64 -> Word8 -> ByteString
LS.replicate (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
LS.length ByteString
bs') Word8
0

parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input =
  let lenb :: W256
lenb = ByteString -> W256
word (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
$ W256 -> W256 -> ByteString -> ByteString
lazySlice  W256
0 W256
32 ByteString
input
      lene :: W256
lene = 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
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
32 W256
64 ByteString
input
      lenm :: W256
lenm = 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
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
64 W256
96 ByteString
input
  in (W256
lenb, W256
lene, W256
lenm)

--- checks if a range of ByteString bs starting at offset and length size is all zeros.
isZero :: W256 -> W256 -> ByteString -> Bool
isZero :: W256 -> W256 -> ByteString -> Bool
isZero W256
offset W256
size ByteString
bs =
  (Word8 -> Bool) -> ByteString -> Bool
LS.all (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 (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      Int64 -> ByteString -> ByteString
LS.drop (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
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 (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
LS.init ByteString
xs)
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall target source. From source target => source -> target
into (HasCallStack => ByteString -> Word8
ByteString -> Word8
LS.last ByteString
xs)

-- * Opcode helper actions

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

pushTo :: MonadState s m => Lens s s [a] [a] -> a -> m ()
pushTo :: forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Lens s s [a] [a]
f a
x = Lens s s [a] [a]
f Lens s s [a] [a] -> ([a] -> [a]) -> m ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (a
x :)

pushToSequence :: MonadState s m => Setter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence :: forall s (m :: * -> *) a.
MonadState s m =>
Setter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence Setter s s (Seq a) (Seq a)
f a
x = Setter s s (Seq a) (Seq a)
f Setter s s (Seq a) (Seq a) -> (Seq a -> Seq a) -> m ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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 = (VM
vm.state.contract, VM
vm.state.pc)

query :: Query -> EVM ()
query :: Query -> EVM ()
query = Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (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
. Effect -> VMResult
HandleEffect (Effect -> VMResult) -> (Query -> Effect) -> Query -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Effect
Query

choose :: Choose -> EVM ()
choose :: Choose -> EVM ()
choose = Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result (Maybe VMResult -> EVM ())
-> (Choose -> Maybe VMResult) -> Choose -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (VMResult -> Maybe VMResult)
-> (Choose -> VMResult) -> Choose -> Maybe VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect -> VMResult
HandleEffect (Effect -> VMResult) -> (Choose -> Effect) -> Choose -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choose -> Effect
Choose

branch :: CodeLocation -> Expr EWord -> (Bool -> EVM ()) -> EVM ()
branch :: CodeLocation -> Expr 'EWord -> (Bool -> EVM ()) -> EVM ()
branch CodeLocation
loc Expr 'EWord
cond Bool -> EVM ()
continue = do
  [Prop]
pathconds <- Lens VM VM [Prop] [Prop] -> StateT VM Identity [Prop]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Lens VM VM [Prop] [Prop]
#constraints
  Query -> EVM ()
query (Query -> EVM ()) -> Query -> EVM ()
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> [Prop] -> (BranchCondition -> EVM ()) -> Query
PleaseAskSMT Expr 'EWord
cond [Prop]
pathconds BranchCondition -> EVM ()
choosePath
  where
    choosePath :: BranchCondition -> EVM ()
choosePath (Case Bool
v) = do
      Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result Maybe VMResult
forall a. Maybe a
Nothing
      Lens VM VM [Prop] [Prop] -> Prop -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Lens VM VM [Prop] [Prop]
#constraints (Prop -> EVM ()) -> Prop -> EVM ()
forall a b. (a -> b) -> a -> b
$ if Bool
v then (Expr 'EWord
cond Expr 'EWord -> Expr 'EWord -> Prop
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
./= W256 -> Expr 'EWord
Lit W256
0) else (Expr 'EWord
cond Expr 'EWord -> Expr 'EWord -> Prop
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== W256 -> Expr 'EWord
Lit W256
0)
      (Int
iteration, [Expr 'EWord]
_) <- Optic' A_Lens NoIx VM (Int, [Expr 'EWord])
-> StateT VM Identity (Int, [Expr 'EWord])
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  VM
  VM
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
#iterations Optic
  A_Lens
  NoIx
  VM
  VM
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     NoIx
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map CodeLocation (Int, [Expr 'EWord]))
-> Lens'
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation (Int, [Expr 'EWord]))
loc Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (Int, [Expr 'EWord]))
  (Maybe (Int, [Expr 'EWord]))
-> Optic
     An_Iso
     NoIx
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
     (Int, [Expr 'EWord])
     (Int, [Expr 'EWord])
-> Optic' A_Lens NoIx VM (Int, [Expr 'EWord])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Int, [Expr 'EWord])
-> Optic
     An_Iso
     NoIx
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
     (Int, [Expr 'EWord])
     (Int, [Expr 'EWord])
forall a. Eq a => a -> Iso' (Maybe a) a
non (Int
0,[]))
      [Expr 'EWord]
stack <- Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT VM Identity [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack)
      Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
  (Maybe Bool)
-> Maybe Bool -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens
     NoIx
     Cache
     Cache
     (Map (CodeLocation, Int) Bool)
     (Map (CodeLocation, Int) Bool)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Map (CodeLocation, Int) Bool)
     (Map (CodeLocation, Int) Bool)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  Cache
  Cache
  (Map (CodeLocation, Int) Bool)
  (Map (CodeLocation, Int) Bool)
#path Optic
  A_Lens
  NoIx
  VM
  VM
  (Map (CodeLocation, Int) Bool)
  (Map (CodeLocation, Int) Bool)
-> Optic
     A_Lens
     NoIx
     (Map (CodeLocation, Int) Bool)
     (Map (CodeLocation, Int) Bool)
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
     (Maybe Bool)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
     (Maybe Bool)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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
loc, Int
iteration)) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
v)
      Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
  (Maybe (Int, [Expr 'EWord]))
-> Maybe (Int, [Expr 'EWord]) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens
  NoIx
  VM
  VM
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
#iterations Optic
  A_Lens
  NoIx
  VM
  VM
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     NoIx
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
     (Maybe (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
     (Maybe (Int, [Expr 'EWord]))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map CodeLocation (Int, [Expr 'EWord]))
-> Lens'
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation (Int, [Expr 'EWord]))
loc) ((Int, [Expr 'EWord]) -> Maybe (Int, [Expr 'EWord])
forall a. a -> Maybe a
Just (Int
iteration Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Expr 'EWord]
stack))
      Bool -> EVM ()
continue Bool
v
    -- Both paths are possible; we ask for more input
    choosePath BranchCondition
Unknown =
      Choose -> EVM ()
choose (Choose -> EVM ())
-> ((Bool -> EVM ()) -> Choose) -> (Bool -> EVM ()) -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> (Bool -> EVM ()) -> Choose
PleaseChoosePath Expr 'EWord
cond ((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

-- | Construct RPC Query and halt execution until resolved
fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr Contract -> EVM ()
continue =
  Optic' A_Lens NoIx VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe Contract)
     (Maybe Contract)
-> Optic' A_Lens NoIx VM (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
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 ->
      Optic' A_Lens NoIx VM (Maybe Contract)
-> StateT VM Identity (Maybe Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetchedContracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe Contract)
     (Maybe Contract)
-> Optic' A_Lens NoIx VM (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Contract
c -> do
          Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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
          Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM (Maybe VMResult) (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
. Effect -> VMResult
HandleEffect (Effect -> VMResult) -> (Query -> Effect) -> Query -> VMResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Effect
Query (Query -> EVM ()) -> Query -> EVM ()
forall a b. (a -> b) -> a -> b
$
            Addr -> (Contract -> EVM ()) -> Query
PleaseFetchContract Addr
addr
              (\Contract
c -> do Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetchedContracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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)
                        Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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)
                        Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result Maybe VMResult
forall a. Maybe a
Nothing
                        Contract -> EVM ()
continue Contract
c)

accessStorage
  :: Addr
  -> Expr EWord
  -> (Expr EWord -> EVM ())
  -> EVM ()
accessStorage :: Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
addr Expr 'EWord
slot Expr 'EWord -> EVM ()
continue = do
  Expr 'Storage
store <- (.env.storage) (VM -> Expr 'Storage)
-> StateT VM Identity VM -> StateT VM Identity (Expr 'Storage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  Optic' A_Lens NoIx VM (Maybe (IxValue (Map Addr Contract)))
-> StateT VM Identity (Maybe (IxValue (Map Addr Contract)))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
-> Optic' A_Lens NoIx VM (Maybe (IxValue (Map Addr Contract)))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 (IxValue (Map Addr Contract)))
-> (Maybe (IxValue (Map Addr Contract)) -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just IxValue (Map Addr Contract)
c ->
      case Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot Expr 'Storage
store of
        -- Notice that if storage is symbolic, we always continue straight away
        Just Expr 'EWord
x ->
          Expr 'EWord -> EVM ()
continue Expr 'EWord
x
        Maybe (Expr 'EWord)
Nothing ->
          if IxValue (Map Addr Contract)
c.external then
            Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
slot [Char]
"cannot read symbolic slots via RPC" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
litSlot -> do
              -- check if the slot is cached
              Map W256 (Map W256 W256)
cachedStore <- (.cache.fetchedStorage) (VM -> Map W256 (Map W256 W256))
-> StateT VM Identity VM
-> StateT VM Identity (Map W256 (Map W256 W256))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
              case W256 -> Map W256 (Map W256 W256) -> Maybe (Map W256 W256)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Addr -> W256
forall target source. From source target => source -> target
into Addr
addr) Map W256 (Map W256 W256)
cachedStore Maybe (Map W256 W256)
-> (Map W256 W256 -> Maybe W256) -> Maybe W256
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= W256 -> Map W256 W256 -> Maybe W256
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup W256
litSlot of
                Maybe W256
Nothing -> W256 -> EVM ()
mkQuery W256
litSlot
                Just W256
val -> Expr 'EWord -> EVM ()
continue (W256 -> Expr 'EWord
Lit W256
val)
          else do
            -- TODO: is this actually needed?
            Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
0))
            Expr 'EWord -> EVM ()
continue (Expr 'EWord -> EVM ()) -> Expr 'EWord -> EVM ()
forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord
Lit W256
0
    Maybe (IxValue (Map Addr Contract))
Nothing ->
      Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ ->
        Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
addr Expr 'EWord
slot Expr 'EWord -> EVM ()
continue
  where
      mkQuery :: W256 -> EVM ()
mkQuery W256
s = Query -> EVM ()
query (Query -> EVM ()) -> Query -> EVM ()
forall a b. (a -> b) -> a -> b
$
                    Addr -> W256 -> (W256 -> EVM ()) -> Query
PleaseFetchSlot Addr
addr W256
s
                      (\W256
x -> do
                          Optic An_AffineTraversal NoIx VM VM (Map W256 W256) (Map W256 W256)
-> (Map W256 W256 -> Map W256 W256) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens
     NoIx
     Cache
     Cache
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  Cache
  Cache
  (Map W256 (Map W256 W256))
  (Map W256 (Map W256 W256))
#fetchedStorage Optic
  A_Lens
  NoIx
  VM
  VM
  (Map W256 (Map W256 W256))
  (Map W256 (Map W256 W256))
-> Optic
     (IxKind (Map W256 (Map W256 W256)))
     NoIx
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
     (Map W256 W256)
     (Map W256 W256)
-> Optic
     An_AffineTraversal NoIx VM VM (Map W256 W256) (Map W256 W256)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map W256 (Map W256 W256))
-> Optic'
     (IxKind (Map W256 (Map W256 W256)))
     NoIx
     (Map W256 (Map W256 W256))
     (IxValue (Map W256 (Map W256 W256)))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (Addr -> Index (Map W256 (Map W256 W256))
forall target source. From source target => source -> target
into Addr
addr)) (W256 -> W256 -> Map W256 W256 -> Map W256 W256
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert W256
s W256
x)
                          Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
x))
                          Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result Maybe VMResult
forall a. Maybe a
Nothing
                          Expr 'EWord -> EVM ()
continue (W256 -> Expr 'EWord
Lit W256
x))

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

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

-- * How to finalize a transaction
finalize :: EVM ()
finalize :: EVM ()
finalize = do
  let
    revertContracts :: EVM ()
revertContracts  = Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> StateT VM Identity (Map Addr Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic
     A_Lens NoIx TxState TxState (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx TxState TxState (Map Addr Contract) (Map Addr Contract)
#txReversion) StateT VM Identity (Map Addr Contract)
-> (Map Addr Contract -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Map Addr Contract -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts)
    revertSubstate :: EVM ()
revertSubstate   = Optic A_Lens NoIx VM VM SubState SubState -> SubState -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate) ([Addr]
-> [Addr]
-> Set Addr
-> Set (Addr, W256)
-> [(Addr, Word64)]
-> 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, Word64)]
forall a. Monoid a => a
mempty)

  Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> StateT VM Identity (Maybe VMResult)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result StateT VM Identity (Maybe VMResult)
-> (Maybe VMResult -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (VMFailure (Revert Expr 'Buf
_)) -> do
      EVM ()
revertContracts
      EVM ()
revertSubstate
    Just (VMFailure EvmError
_) -> do
      -- burn remaining gas
      Optic A_Lens NoIx VM VM Word64 Word64 -> Word64 -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas) Word64
0
      EVM ()
revertContracts
      EVM ()
revertSubstate
    Just (VMSuccess Expr 'Buf
output) -> do
      -- deposit the code from a creation tx
      Int
pc' <- Optic A_Lens NoIx VM VM Int Int -> StateT VM Identity Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Int Int
-> Optic A_Lens NoIx VM VM Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Int Int
#pc)
      Bool
creation <- Optic' A_Lens NoIx VM Bool -> EVM Bool
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState Bool Bool
-> Optic' A_Lens NoIx VM Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState Bool Bool
#isCreate)
      Addr
createe  <- Optic' A_Lens NoIx VM Addr -> StateT VM Identity Addr
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr 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
<$> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> StateT VM Identity (Map Addr Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts)
      let onContractCode :: ContractCode -> EVM ()
onContractCode ContractCode
contractCode =
            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 ContractCode
contractCode
      case Expr 'Buf
output of
        ConcreteBuf ByteString
bs ->
          ContractCode -> EVM ()
onContractCode (ContractCode -> EVM ()) -> ContractCode -> EVM ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
bs)
        Expr 'Buf
_ ->
          case Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList Expr 'Buf
output of
            Maybe (Vector (Expr 'Byte))
Nothing ->
              PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$
                Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc' [Char]
"runtime code cannot have an abstract lentgh" ([Expr 'Buf] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
output])
            Just Vector (Expr 'Byte)
ops ->
              ContractCode -> EVM ()
onContractCode (ContractCode -> EVM ()) -> ContractCode -> EVM ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
ops)
    Maybe VMResult
_ ->
      [Char] -> EVM ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Finalising an unfinished tx."

  -- compute and pay the refund to the caller and the
  -- corresponding payment to the miner
  Block
block        <- Optic' A_Lens NoIx VM Block -> StateT VM Identity Block
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx VM Block
#block
  TxState
tx           <- Optic A_Lens NoIx VM VM TxState TxState
-> StateT VM Identity TxState
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic A_Lens NoIx VM VM TxState TxState
#tx
  Word64
gasRemaining <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas)

  let
    sumRefunds :: Word64
sumRefunds   = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Addr, Word64) -> Word64
forall a b. (a, b) -> b
snd ((Addr, Word64) -> Word64) -> [(Addr, Word64)] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxState
tx.substate.refunds)
    gasUsed :: Word64
gasUsed      = TxState
tx.gaslimit Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gasRemaining
    cappedRefund :: Word64
cappedRefund = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
quot Word64
gasUsed Word64
5) Word64
sumRefunds
    originPay :: W256
originPay    = (Word64 -> W256
forall target source. From source target => source -> target
into (Word64 -> W256) -> Word64 -> W256
forall a b. (a -> b) -> a -> b
$ Word64
gasRemaining Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cappedRefund) W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* TxState
tx.gasprice
    minerPay :: W256
minerPay     = TxState
tx.priorityFee W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* (Word64 -> W256
forall target source. From source target => source -> target
into Word64
gasUsed)

  Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (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 (Optic A_Lens NoIx Contract Contract W256 W256
-> (W256 -> W256) -> Contract -> Contract
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Contract Contract W256 W256
#balance (W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
originPay)) TxState
tx.origin)
  Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (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 (Optic A_Lens NoIx Contract Contract W256 W256
-> (W256 -> W256) -> Contract -> Contract
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Contract Contract W256 W256
#balance (W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
minerPay)) Block
block.coinbase)
  Addr -> EVM ()
touchAccount Block
block.coinbase

  -- 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 <- Optic' A_Lens NoIx VM [Addr] -> StateT VM Identity [Addr]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState [Addr] [Addr]
-> Optic' A_Lens NoIx VM [Addr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState [Addr] [Addr]
#selfdestructs)
  Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (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
k Addr -> [Addr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Addr]
destroyedAddresses)))
  -- then, clear any remaining empty and touched addresses
  [Addr]
touchedAddresses <- Optic' A_Lens NoIx VM [Addr] -> StateT VM Identity [Addr]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState [Addr] [Addr]
-> Optic' A_Lens NoIx VM [Addr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState [Addr] [Addr]
#touchedAccounts)
  Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (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
k Addr -> [Addr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Addr]
touchedAddresses) Bool -> Bool -> Bool
&& Contract -> Bool
accountEmpty Contract
a)))

-- | Loads the selected contract as the current contract to execute
loadContract :: Addr -> EVM ()
loadContract :: Addr -> EVM ()
loadContract Addr
target =
  Optic' An_AffineTraversal NoIx VM ContractCode
-> StateT VM Identity (Maybe ContractCode)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
target Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     ContractCode
     ContractCode
-> Optic' An_AffineTraversal NoIx VM ContractCode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  ContractCode
  ContractCode
#contractcode) StateT VM Identity (Maybe ContractCode)
-> (Maybe ContractCode -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe ContractCode
Nothing ->
        [Char] -> EVM ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Call target doesn't exist"
      Just ContractCode
targetCode -> do
        Optic' A_Lens NoIx VM Addr -> Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract) Addr
target
        Optic A_Lens NoIx VM VM ContractCode ContractCode
-> ContractCode -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState ContractCode ContractCode
-> Optic A_Lens NoIx VM VM ContractCode ContractCode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState ContractCode ContractCode
#code)     ContractCode
targetCode
        Optic' A_Lens NoIx VM Addr -> Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr Addr
#codeContract) Addr
target

limitStack :: Int -> EVM () -> EVM ()
limitStack :: Int -> EVM () -> EVM ()
limitStack Int
n EVM ()
continue = do
  [Expr 'EWord]
stk <- Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT VM Identity [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack)
  if [Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
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 EvmError -> EVM ()
vmError EvmError
StackLimitExceeded
    else EVM ()
continue

notStatic :: EVM () -> EVM ()
notStatic :: EVM () -> EVM ()
notStatic EVM ()
continue = do
  Bool
bad <- Optic' A_Lens NoIx VM Bool -> EVM Bool
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Bool Bool
-> Optic' A_Lens NoIx VM Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Bool Bool
#static)
  if Bool
bad
    then EvmError -> EVM ()
vmError EvmError
StateChangeWhileStatic
    else EVM ()
continue

-- | Burn gas, failing if insufficient gas is available
burn :: Word64 -> EVM () -> EVM ()
burn :: Word64 -> EVM () -> EVM ()
burn Word64
n EVM ()
continue = do
  Word64
available <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas)
  if Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
available
    then do
      #state % #gas %= (subtract n)
      #burned %= (+ n)
      continue
    else
      EvmError -> EVM ()
vmError (Word64 -> Word64 -> EvmError
OutOfGas Word64
available Word64
n)

forceConcrete :: Expr EWord -> String -> (W256 -> EVM ()) -> EVM ()
forceConcrete :: Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
n [Char]
msg W256 -> EVM ()
continue = case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n of
  Maybe W256
Nothing -> do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
n])
  Just W256
c -> W256 -> EVM ()
continue W256
c

forceConcrete2 :: (Expr EWord, Expr EWord) -> String -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 :: (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
n,Expr 'EWord
m) [Char]
msg (W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
c, Just W256
d) -> (W256, W256) -> EVM ()
continue (W256
c, W256
d)
  (Maybe W256, Maybe W256)
_ -> do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
n, Expr 'EWord
m])

forceConcrete3 :: (Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
k,Expr 'EWord
n,Expr 'EWord
m) [Char]
msg (W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
c, Just W256
d, Just W256
f) -> (W256, W256, W256) -> EVM ()
continue (W256
c, W256
d, W256
f)
  (Maybe W256, Maybe W256, Maybe W256)
_ -> do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
k, Expr 'EWord
n, Expr 'EWord
m])

forceConcrete4 :: (Expr EWord, Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete4 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete4 (Expr 'EWord
k,Expr 'EWord
l,Expr 'EWord
n,Expr 'EWord
m) [Char]
msg (W256, W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
l, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
b, Just W256
c, Just W256
d, Just W256
f) -> (W256, W256, W256, W256) -> EVM ()
continue (W256
b, W256
c, W256
d, W256
f)
  (Maybe W256, Maybe W256, Maybe W256, Maybe W256)
_ -> do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
k, Expr 'EWord
l, Expr 'EWord
n, Expr 'EWord
m])

forceConcrete5 :: (Expr EWord, Expr EWord, Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete5 (Expr 'EWord
k,Expr 'EWord
l,Expr 'EWord
m,Expr 'EWord
n,Expr 'EWord
o) [Char]
msg (W256, W256, W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
l, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
o) of
  (Just W256
a, Just W256
b, Just W256
c, Just W256
d, Just W256
e) -> (W256, W256, W256, W256, W256) -> EVM ()
continue (W256
a, W256
b, W256
c, W256
d, W256
e)
  (Maybe W256, Maybe W256, Maybe W256, Maybe W256, Maybe W256)
_ -> do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
k, Expr 'EWord
l, Expr 'EWord
m, Expr 'EWord
n, Expr 'EWord
o])

forceConcrete6 :: (Expr EWord, Expr EWord, Expr EWord, Expr EWord, Expr EWord, Expr EWord) -> String -> ((W256, W256, W256, W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete6 :: (Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
 Expr 'EWord)
-> [Char]
-> ((W256, W256, W256, W256, W256, W256) -> EVM ())
-> EVM ()
forceConcrete6 (Expr 'EWord
k,Expr 'EWord
l,Expr 'EWord
m,Expr 'EWord
n,Expr 'EWord
o,Expr 'EWord
p) [Char]
msg (W256, W256, W256, W256, W256, W256) -> EVM ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
k, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
l, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
o, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
p) of
  (Just W256
a, Just W256
b, Just W256
c, Just W256
d, Just W256
e, Just W256
f) -> (W256, W256, W256, W256, W256, W256) -> EVM ()
continue (W256
a, W256
b, W256
c, W256
d, W256
e, W256
f)
  (Maybe W256, Maybe W256, Maybe W256, Maybe W256, Maybe W256,
 Maybe W256)
_ -> do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
k, Expr 'EWord
l, Expr 'EWord
m, Expr 'EWord
n, Expr 'EWord
o, Expr 'EWord
p])

forceConcreteBuf :: Expr Buf -> String -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf :: Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf (ConcreteBuf ByteString
b) [Char]
_ ByteString -> EVM ()
continue = ByteString -> EVM ()
continue ByteString
b
forceConcreteBuf Expr 'Buf
b [Char]
msg ByteString -> EVM ()
_ = do
    VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg ([Expr 'Buf] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
b])

-- * Substate manipulation
refund :: Word64 -> EVM ()
refund :: Word64 -> EVM ()
refund Word64
n = do
  Addr
self <- Optic' A_Lens NoIx VM Addr -> StateT VM Identity Addr
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract)
  Lens VM VM [(Addr, Word64)] [(Addr, Word64)]
-> (Addr, Word64) -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic
     A_Lens NoIx SubState SubState [(Addr, Word64)] [(Addr, Word64)]
-> Lens VM VM [(Addr, Word64)] [(Addr, Word64)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx SubState SubState [(Addr, Word64)] [(Addr, Word64)]
#refunds) (Addr
self, Word64
n)

unRefund :: Word64 -> EVM ()
unRefund :: Word64 -> EVM ()
unRefund Word64
n = do
  Addr
self <- Optic' A_Lens NoIx VM Addr -> StateT VM Identity Addr
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract)
  [(Addr, Word64)]
refs <- Lens VM VM [(Addr, Word64)] [(Addr, Word64)]
-> StateT VM Identity [(Addr, Word64)]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic
     A_Lens NoIx SubState SubState [(Addr, Word64)] [(Addr, Word64)]
-> Lens VM VM [(Addr, Word64)] [(Addr, Word64)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx SubState SubState [(Addr, Word64)] [(Addr, Word64)]
#refunds)
  Lens VM VM [(Addr, Word64)] [(Addr, Word64)]
-> [(Addr, Word64)] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic
     A_Lens NoIx SubState SubState [(Addr, Word64)] [(Addr, Word64)]
-> Lens VM VM [(Addr, Word64)] [(Addr, Word64)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx SubState SubState [(Addr, Word64)] [(Addr, Word64)]
#refunds)
    (((Addr, Word64) -> Bool) -> [(Addr, Word64)] -> [(Addr, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Addr
a,Word64
b) -> Bool -> Bool
not (Addr
a Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
self Bool -> Bool -> Bool
&& Word64
b Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n)) [(Addr, Word64)]
refs)

touchAccount :: Addr -> EVM()
touchAccount :: Addr -> EVM ()
touchAccount = Optic' A_Lens NoIx VM [Addr] -> Addr -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo ((Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate) Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState [Addr] [Addr]
-> Optic' A_Lens NoIx VM [Addr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState [Addr] [Addr]
#touchedAccounts)

selfdestruct :: Addr -> EVM()
selfdestruct :: Addr -> EVM ()
selfdestruct = Optic' A_Lens NoIx VM [Addr] -> Addr -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo ((Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate) Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState [Addr] [Addr]
-> Optic' A_Lens NoIx VM [Addr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState [Addr] [Addr]
#selfdestructs)

accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn Addr
x EVM ()
cont = do
  FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- Optic' A_Lens NoIx VM (FeeSchedule Word64)
-> StateT VM Identity (FeeSchedule Word64)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic' A_Lens NoIx VM Block
#block Optic' A_Lens NoIx VM Block
-> Optic
     A_Lens NoIx Block Block (FeeSchedule Word64) (FeeSchedule Word64)
-> Optic' A_Lens NoIx VM (FeeSchedule Word64)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx Block Block (FeeSchedule Word64) (FeeSchedule Word64)
#schedule)
  Bool
acc <- Addr -> EVM Bool
accessAccountForGas Addr
x
  let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
  Word64 -> EVM () -> EVM ()
burn Word64
cost EVM ()
cont

-- | returns a wrapped boolean- if true, this address has been touched before in the txn (warm gas cost as in EIP 2929)
-- otherwise cold
accessAccountForGas :: Addr -> EVM Bool
accessAccountForGas :: Addr -> EVM Bool
accessAccountForGas Addr
addr = do
  Set Addr
accessedAddrs <- Optic' A_Lens NoIx VM (Set Addr) -> StateT VM Identity (Set Addr)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState (Set Addr) (Set Addr)
-> Optic' A_Lens NoIx VM (Set Addr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState (Set Addr) (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
  Optic' A_Lens NoIx VM (Set Addr) -> Set Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState (Set Addr) (Set Addr)
-> Optic' A_Lens NoIx VM (Set Addr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState (Set Addr) (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 a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
accessed

-- | returns a wrapped boolean- if true, this slot has been touched before in the txn (warm gas cost as in EIP 2929)
-- otherwise cold
accessStorageForGas :: Addr -> Expr EWord -> EVM Bool
accessStorageForGas :: Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
addr Expr 'EWord
key = do
  Set (Addr, W256)
accessedStrkeys <- Optic' A_Lens NoIx VM (Set (Addr, W256))
-> StateT VM Identity (Set (Addr, W256))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic
     A_Lens NoIx SubState SubState (Set (Addr, W256)) (Set (Addr, W256))
-> Optic' A_Lens NoIx VM (Set (Addr, W256))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx SubState SubState (Set (Addr, W256)) (Set (Addr, W256))
#accessedStorageKeys)
  case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
key of
    Just W256
litword -> do
      let accessed :: Bool
accessed = (Addr, W256) -> Set (Addr, W256) -> Bool
forall a. Ord a => a -> Set a -> Bool
member (Addr
addr, W256
litword) Set (Addr, W256)
accessedStrkeys
      Optic' A_Lens NoIx VM (Set (Addr, W256))
-> Set (Addr, W256) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic
     A_Lens NoIx SubState SubState (Set (Addr, W256)) (Set (Addr, W256))
-> Optic' A_Lens NoIx VM (Set (Addr, W256))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx SubState SubState (Set (Addr, W256)) (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
litword) Set (Addr, W256)
accessedStrkeys)
      Bool -> EVM Bool
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
accessed
    Maybe W256
_ -> Bool -> EVM Bool
forall a. a -> StateT VM Identity a
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 target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (ByteString -> W256
keccak' ByteString
"hevm cheat code")

cheat
  :: (?op :: Word8)
  => (W256, W256) -> (W256, W256)
  -> EVM ()
cheat :: (?op::Word8) => (W256, W256) -> (W256, W256) -> EVM ()
cheat (W256
inOffset, W256
inSize) (W256
outOffset, W256
outSize) = do
  Expr 'Buf
mem <- Optic' A_Lens NoIx VM (Expr 'Buf) -> StateT VM Identity (Expr 'Buf)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory)
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let
    abi :: Expr 'EWord
abi = Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
inOffset) Expr 'Buf
mem
    input :: Expr 'Buf
input = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> W256 -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ W256
inOffset W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
4) (W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> W256 -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ W256
inSize W256 -> W256 -> W256
forall a. Num a => a -> a -> a
- W256
4) VM
vm
  TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ FrameContext -> TraceData
FrameTrace (Addr
-> Addr
-> W256
-> W256
-> Expr 'EWord
-> Maybe W256
-> Expr 'Buf
-> (Map Addr Contract, Expr 'Storage)
-> SubState
-> FrameContext
CallContext Addr
cheatCode Addr
cheatCode W256
inOffset W256
inSize (W256 -> Expr 'EWord
Lit W256
0) (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
abi) Expr 'Buf
input (VM
vm.env.contracts, VM
vm.env.storage) VM
vm.tx.substate)
  case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
abi of
    Maybe W256
Nothing -> PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
"symbolic cheatcode selector" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
abi])
    Just (W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto -> FunctionSelector
abi') ->
      case FunctionSelector
-> Map FunctionSelector CheatAction -> Maybe CheatAction
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionSelector
abi' Map FunctionSelector CheatAction
cheatActions of
        Maybe CheatAction
Nothing ->
          EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
abi')
        Just CheatAction
action -> do
            CheatAction
action (W256 -> Expr 'EWord
Lit W256
outOffset) (W256 -> Expr 'EWord
Lit W256
outSize) Expr 'Buf
input
            EVM ()
popTrace
            EVM ()
(?op::Word8) => EVM ()
next
            W256 -> EVM ()
push W256
1

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

cheatActions :: Map FunctionSelector CheatAction
cheatActions :: Map FunctionSelector CheatAction
cheatActions =
  [(FunctionSelector, CheatAction)]
-> Map FunctionSelector CheatAction
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"ffi(string[])" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
outSize Expr 'Buf
input -> do
          VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
          if VM
vm.allowFFI then
            case [AbiType] -> Expr 'Buf -> AbiVals
decodeBuf [AbiType -> AbiType
AbiArrayDynamicType AbiType
AbiStringType] Expr 'Buf
input of
              CAbi [AbiValue]
valsArr -> case [AbiValue]
valsArr of
                [AbiArrayDynamic AbiType
AbiStringType Vector AbiValue
strsV] ->
                  let
                    cmd :: [[Char]]
cmd = (AbiValue -> [Char]) -> [AbiValue] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            (\case
                              (AbiString ByteString
a) -> Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
a
                              AbiValue
_ -> [Char]
"")
                            (Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
V.toList Vector AbiValue
strsV)
                    cont :: ByteString -> EVM ()
cont ByteString
bs = do
                      let encoded :: Expr 'Buf
encoded = ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
                      Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
encoded
                      Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
encoded Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
                      Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result Maybe VMResult
forall a. Maybe a
Nothing
                  in Query -> EVM ()
query ([[Char]] -> (ByteString -> EVM ()) -> Query
PleaseDoFFI [[Char]]
cmd ByteString -> EVM ()
cont)
                [AbiValue]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
              AbiVals
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
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 EvmError -> EVM ()
vmError (EvmError -> EVM ())
-> (ByteString -> EvmError) -> ByteString -> EVM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> EvmError
Revert (Expr 'Buf -> EvmError)
-> (ByteString -> Expr 'Buf) -> ByteString -> EvmError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expr 'Buf
ConcreteBuf (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
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"warp(uint256)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
x]  -> Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic' A_Lens NoIx VM Block
#block Optic' A_Lens NoIx VM Block
-> Optic A_Lens NoIx Block Block (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Block Block (Expr 'EWord) (Expr 'EWord)
#timestamp) Expr 'EWord
x
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"roll(uint256)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
x] -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x [Char]
"cannot roll to a symbolic block number" (Optic A_Lens NoIx VM VM W256 W256 -> W256 -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic' A_Lens NoIx VM Block
#block Optic' A_Lens NoIx VM Block
-> Optic A_Lens NoIx Block Block W256 W256
-> Optic A_Lens NoIx VM VM W256 W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Block Block W256 W256
#number))
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"store(address,bytes32,bytes32)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
3 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
slot, Expr 'EWord
new] ->
            Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
a [Char]
"cannot store at a symbolic address" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto -> Addr
a') ->
              Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
a' ((Contract -> EVM ()) -> EVM ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
a') Expr 'EWord
slot Expr 'EWord
new)
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"load(address,bytes32)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
slot] ->
            Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
a [Char]
"cannot load from a symbolic address" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto -> Addr
a') ->
              Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
a' Expr 'EWord
slot ((Expr 'EWord -> EVM ()) -> EVM ())
-> (Expr 'EWord -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
res -> do
                Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata Optic' A_Lens NoIx VM (Expr 'Buf)
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Expr 'EWord
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
res
                Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory Optic' A_Lens NoIx VM (Expr 'Buf)
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Expr 'EWord
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At Expr 'EWord
outOffset) Expr 'EWord
res
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"sign(uint256,bytes32)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
sk, Expr 'EWord
hash] ->
            (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
sk, Expr 'EWord
hash) [Char]
"cannot sign symbolic data" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \(W256
sk', W256
hash') -> do
              let (Word8
v,W256
r,W256
s) = W256 -> Integer -> (Word8, W256, W256)
EVM.Sign.sign W256
hash' (W256 -> Integer
forall a. Integral a => a -> Integer
toInteger W256
sk')
                  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
V.fromList
                      [ Int -> Word256 -> AbiValue
AbiUInt Int
8 (Word256 -> AbiValue) -> Word256 -> AbiValue
forall a b. (a -> b) -> a -> b
$ Word8 -> Word256
forall target source. From source target => source -> target
into Word8
v
                      , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
r)
                      , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
s)
                      ])
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded)
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded) (W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord)
-> (ByteString -> W256) -> ByteString -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> W256) -> (ByteString -> Int) -> ByteString -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Expr 'EWord) -> ByteString -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString
encoded) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"addr(uint256)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
sk] -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
sk [Char]
"cannot derive address for a symbolic key" ((W256 -> EVM ()) -> EVM ()) -> (W256 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \W256
sk' -> do
            let a :: Maybe Addr
a = Integer -> Maybe Addr
EVM.Sign.deriveAddr (Integer -> Maybe Addr) -> Integer -> Maybe Addr
forall a b. (a -> b) -> a -> b
$ W256 -> Integer
forall target source. From source target => source -> target
into W256
sk'
            case Maybe Addr
a of
              Maybe Addr
Nothing -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
              Just Addr
address -> do
                let expAddr :: Expr 'EWord
expAddr = Addr -> Expr 'EWord
litAddr Addr
address
                Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata Optic' A_Lens NoIx VM (Expr 'Buf)
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Expr 'EWord
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
expAddr
                Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory Optic' A_Lens NoIx VM (Expr 'Buf)
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens NoIx VM VM (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Expr 'EWord
-> Optic
     A_Lens NoIx (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At Expr 'EWord
outOffset) Expr 'EWord
expAddr
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"prank(address)" ((FunctionSelector -> CheatAction)
 -> (FunctionSelector, CheatAction))
-> (FunctionSelector -> CheatAction)
-> (FunctionSelector, CheatAction)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
addr]  -> Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
-> Maybe Addr -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe Addr) (Maybe Addr)
#overrideCaller (Expr 'EWord -> Maybe Addr
Expr.exprToAddr Expr 'EWord
addr)
          [Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)

    ]
  where
    action :: ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
s FunctionSelector -> b
f = (ByteString -> FunctionSelector
abiKeccak ByteString
s, FunctionSelector -> b
f (ByteString -> FunctionSelector
abiKeccak ByteString
s))

-- * General call implementation ("delegateCall")
-- note that the continuation is ignored in the precompile case
delegateCall
  :: (?op :: Word8)
  => Contract -> Word64 -> Expr EWord -> Expr EWord -> W256 -> W256 -> W256 -> W256 -> W256
  -> [Expr EWord]
  -> (Addr -> EVM ())
  -> EVM ()
delegateCall :: (?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this Word64
gasGiven Expr 'EWord
xTo Expr 'EWord
xContext W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs Addr -> EVM ()
continue =
  (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xTo, Expr 'EWord
xContext) [Char]
"cannot delegateCall with symbolic target or context" (((W256, W256) -> EVM ()) -> EVM ())
-> ((W256, W256) -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
    \((W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto -> Addr
xTo'), (W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto -> 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
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
precompiledContract Contract
this Word64
gasGiven Addr
xTo' Addr
xContext' W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs
      else if Addr
xTo' Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
cheatCode then
        do
          Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) [Expr 'EWord]
xs
          (?op::Word8) => (W256, W256) -> (W256, W256) -> EVM ()
(W256, W256) -> (W256, W256) -> EVM ()
cheat (W256
xInOffset, W256
xInSize) (W256
xOutOffset, W256
xOutSize)
      else
        (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
gasGiven Addr
xContext' Addr
xTo' W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs ((Word64 -> EVM ()) -> EVM ()) -> (Word64 -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$
        \Word64
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 ()) -> (Contract -> EVM ()) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \Contract
target ->
                Word64 -> EVM () -> EVM ()
burn Word64
xGas (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                  let newContext :: FrameContext
newContext = CallContext
                                    { $sel:target:CreationContext :: Addr
target    = Addr
xTo'
                                    , $sel:context:CreationContext :: Addr
context   = Addr
xContext'
                                    , $sel:offset:CreationContext :: W256
offset    = W256
xOutOffset
                                    , $sel:size:CreationContext :: W256
size      = W256
xOutSize
                                    , $sel:codehash:CreationContext :: Expr 'EWord
codehash  = Contract
target.codehash
                                    , $sel:callreversion:CreationContext :: (Map Addr Contract, Expr 'Storage)
callreversion = (VM
vm0.env.contracts, VM
vm0.env.storage)
                                    , $sel:subState:CreationContext :: SubState
subState  = VM
vm0.tx.substate
                                    , $sel:abi:CreationContext :: Maybe W256
abi =
                                        if W256
xInSize W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
>= W256
4
                                        then (Expr 'EWord -> Maybe W256
maybeLitWord (Expr 'EWord -> Maybe W256) -> Expr 'EWord -> Maybe W256
forall a b. (a -> b) -> a -> b
$ Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
xInOffset) VM
vm0.state.memory)
                                        else Maybe W256
forall a. Maybe a
Nothing
                                    , $sel:calldata:CreationContext :: Expr 'Buf
calldata = (Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit W256
xInOffset) (W256 -> Expr 'EWord
Lit W256
xInSize) VM
vm0)
                                    }

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

                  Optic A_Lens NoIx VM VM [Frame] [Frame] -> Frame -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Optic A_Lens NoIx VM VM [Frame] [Frame]
#frames (Frame -> EVM ()) -> Frame -> EVM ()
forall a b. (a -> b) -> a -> b
$ Frame
                    { $sel:state:Frame :: FrameState
state = VM
vm1.state { $sel:stack:FrameState :: [Expr 'EWord]
stack = [Expr 'EWord]
xs }
                    , $sel:context:Frame :: FrameContext
context = FrameContext
newContext
                    }

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

                  Optic A_Lens NoIx VM VM FrameState FrameState
-> StateT FrameState Identity () -> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM FrameState
-> StateT FrameState Identity c -> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic A_Lens NoIx VM VM FrameState FrameState
#state (StateT FrameState Identity () -> EVM ())
-> StateT FrameState Identity () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
                    Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Word64 -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas Word64
xGas
                    Optic A_Lens NoIx FrameState FrameState Int Int
-> Int -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Int Int
#pc Int
0
                    Optic A_Lens NoIx FrameState FrameState ContractCode ContractCode
-> ContractCode -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState ContractCode ContractCode
#code (ContractCode -> ContractCode
clearInitCode Contract
target.contractcode)
                    Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Addr -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Addr Addr
#codeContract Addr
xTo'
                    Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack [Expr 'EWord]
forall a. Monoid a => a
mempty
                    Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory Expr 'Buf
forall a. Monoid a => a
mempty
                    Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Word64 -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState Word64 Word64
#memorySize Word64
0
                    Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata Expr 'Buf
forall a. Monoid a => a
mempty
                    Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> StateT FrameState Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#calldata (Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice (W256 -> Expr 'EWord
Lit W256
xInOffset) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
xInSize) VM
vm0.state.memory Expr 'Buf
forall a. Monoid a => a
mempty)

                  Addr -> EVM ()
continue Addr
xTo'

-- -- * Contract creation

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

create :: (?op :: Word8)
  => Addr -> Contract
  -> W256 -> Word64 -> W256 -> [Expr EWord] -> Addr -> Expr Buf -> EVM ()
create :: (?op::Word8) =>
Addr
-> Contract
-> W256
-> Word64
-> W256
-> [Expr 'EWord]
-> Addr
-> Expr 'Buf
-> EVM ()
create Addr
self Contract
this W256
xSize Word64
xGas W256
xValue [Expr 'EWord]
xs Addr
newAddr Expr 'Buf
initCode = do
  VM
vm0 <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  if Contract
this.nonce W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> W256
forall target source. From source target => source -> target
into (Word64
forall a. Bounded a => a
maxBound :: Word64)
  then do
    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
NonceOverflow
    EVM ()
(?op::Word8) => EVM ()
next
  else if W256
xValue W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> Contract
this.balance
  then do
    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace (EvmError -> TraceData) -> EvmError -> TraceData
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
BalanceTooLow W256
xValue Contract
this.balance
    EVM ()
(?op::Word8) => EVM ()
next
  else if W256
xSize W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> VM
vm0.block.maxCodeSize W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* W256
2
  then do
    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    EvmError -> EVM ()
vmError (EvmError -> EVM ()) -> EvmError -> EVM ()
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
MaxInitCodeSizeExceeded (VM
vm0.block.maxCodeSize W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* W256
2) W256
xSize
  else if [Frame] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VM
vm0.frames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024
  then do
    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    TraceData -> EVM ()
pushTrace (TraceData -> EVM ()) -> TraceData -> EVM ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
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
$ Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
newAddr VM
vm0.env.contracts
  then Word64 -> EVM () -> EVM ()
burn Word64
xGas (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
    Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    Optic An_AffineTraversal NoIx VM VM W256 W256
-> (W256 -> W256) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
self Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#nonce) W256 -> W256
forall a. Enum a => a -> a
succ
    EVM ()
(?op::Word8) => EVM ()
next
  else Word64 -> EVM () -> EVM ()
burn Word64
xGas (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
    Addr -> EVM ()
touchAccount Addr
self
    Addr -> EVM ()
touchAccount Addr
newAddr
    let
    -- unfortunately we have to apply some (pretty hacky)
    -- heuristics here to parse the unstructured buffer read
    -- from memory into a code and data section
    let contract' :: Maybe ContractCode
contract' = do
          Integer
prefixLen <- Expr 'Buf -> Maybe Integer
Expr.concPrefix Expr 'Buf
initCode
          Vector (Expr 'Byte)
prefix <- Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList (Expr 'Buf -> Maybe (Vector (Expr 'Byte)))
-> Expr 'Buf -> Maybe (Vector (Expr 'Byte))
forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'Buf -> Expr 'Buf
Expr.take (Integer -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Integer
prefixLen) Expr 'Buf
initCode
          let sym :: Expr 'Buf
sym = W256 -> Expr 'Buf -> Expr 'Buf
Expr.drop (Integer -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Integer
prefixLen) Expr 'Buf
initCode
          Vector Word8
conc <- (Expr 'Byte -> Maybe Word8)
-> Vector (Expr 'Byte) -> Maybe (Vector Word8)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Expr 'Byte -> Maybe Word8
maybeLitByte Vector (Expr 'Byte)
prefix
          ContractCode -> Maybe ContractCode
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractCode -> Maybe ContractCode)
-> ContractCode -> Maybe ContractCode
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf -> ContractCode
InitCode ([Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> [Word8]
forall a. Vector a -> [a]
V.toList Vector Word8
conc) Expr 'Buf
sym
    case Maybe ContractCode
contract' of
      Maybe ContractCode
Nothing ->
        PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm0.state.pc [Char]
"initcode must have a concrete prefix" []
      Just ContractCode
c -> do
        let
          newContract :: Contract
newContract = ContractCode -> Contract
initialContract ContractCode
c
          newContext :: FrameContext
newContext  =
            CreationContext { $sel:address:CreationContext :: Addr
address   = Addr
newAddr
                            , $sel:codehash:CreationContext :: Expr 'EWord
codehash  = Contract
newContract.codehash
                            , $sel:createreversion:CreationContext :: Map Addr Contract
createreversion = VM
vm0.env.contracts
                            , $sel:substate:CreationContext :: SubState
substate  = VM
vm0.tx.substate
                            }

        Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> StateT (Map Addr Contract) Identity () -> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM (Map Addr Contract)
-> StateT (Map Addr Contract) Identity c -> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (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 (IxValue (Map Addr Contract))
oldAcc <- Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
-> StateT
     (Map Addr Contract) Identity (Maybe (IxValue (Map Addr Contract)))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is 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 :: W256
oldBal = W256
-> (IxValue (Map Addr Contract) -> W256)
-> Maybe (IxValue (Map Addr Contract))
-> W256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe W256
0 (.balance) Maybe (IxValue (Map Addr Contract))
oldAcc

          Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
-> Maybe (IxValue (Map Addr Contract))
-> StateT (Map Addr Contract) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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) (IxValue (Map Addr Contract) -> Maybe (IxValue (Map Addr Contract))
forall a. a -> Maybe a
Just (Contract
newContract Contract
-> (Contract -> IxValue (Map Addr Contract))
-> IxValue (Map Addr Contract)
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Contract (IxValue (Map Addr Contract)) W256 W256
#balance Optic A_Lens NoIx Contract (IxValue (Map Addr Contract)) W256 W256
-> W256 -> Contract -> IxValue (Map Addr Contract)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ W256
oldBal))
          Optic
  An_AffineTraversal
  NoIx
  (Map Addr Contract)
  (Map Addr Contract)
  W256
  W256
-> (W256 -> W256) -> StateT (Map Addr Contract) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
self Optic
  (IxKind (Map Addr Contract))
  NoIx
  (Map Addr Contract)
  (Map Addr Contract)
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic
     An_AffineTraversal
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     W256
     W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#nonce) W256 -> W256
forall a. Enum a => a -> a
succ

        let resetStorage :: Expr 'Storage -> Expr 'Storage
resetStorage = \case
              ConcreteStore Map W256 (Map W256 W256)
s -> Map W256 (Map W256 W256) -> Expr 'Storage
ConcreteStore (W256 -> Map W256 (Map W256 W256) -> Map W256 (Map W256 W256)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Addr -> W256
forall target source. From source target => source -> target
into Addr
newAddr) Map W256 (Map W256 W256)
s)
              Expr 'Storage
AbstractStore -> Expr 'Storage
AbstractStore
              Expr 'Storage
EmptyStore -> Expr 'Storage
EmptyStore
              SStore {} -> [Char] -> Expr 'Storage
forall a. HasCallStack => [Char] -> a
internalError [Char]
"trying to reset symbolic storage with writes in create"
              GVar GVar 'Storage
_  -> [Char] -> Expr 'Storage
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected global variable"

        Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#storage) Expr 'Storage -> Expr 'Storage
resetStorage
        Optic
  A_Lens
  NoIx
  VM
  VM
  (Map W256 (Map W256 W256))
  (Map W256 (Map W256 W256))
-> (Map W256 (Map W256 W256) -> Map W256 (Map W256 W256)) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens
     NoIx
     Env
     Env
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  Env
  Env
  (Map W256 (Map W256 W256))
  (Map W256 (Map W256 W256))
#origStorage) (W256 -> Map W256 (Map W256 W256) -> Map W256 (Map W256 W256)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Addr -> W256
forall target source. From source target => source -> target
into Addr
newAddr))

        Addr -> Addr -> W256 -> EVM ()
transfer Addr
self Addr
newAddr W256
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
        Optic A_Lens NoIx VM VM [Frame] [Frame] -> Frame -> EVM ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Optic A_Lens NoIx VM VM [Frame] [Frame]
#frames (Frame -> EVM ()) -> Frame -> EVM ()
forall a b. (a -> b) -> a -> b
$ Frame
          { $sel:context:Frame :: FrameContext
context = FrameContext
newContext
          , $sel:state:Frame :: FrameState
state   = VM
vm1.state { $sel:stack:FrameState :: [Expr 'EWord]
stack = [Expr 'EWord]
xs }
          }

        Optic A_Lens NoIx VM VM FrameState FrameState
-> FrameState -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM FrameState 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
& Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Addr -> FrameState -> FrameState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract     Addr
newAddr
            FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Addr -> FrameState -> FrameState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameState FrameState Addr Addr
#codeContract Addr
newAddr
            FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameState FrameState ContractCode ContractCode
-> ContractCode -> FrameState -> FrameState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameState FrameState ContractCode ContractCode
#code         ContractCode
c
            FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> FrameState -> FrameState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#callvalue    (W256 -> Expr 'EWord
Lit W256
xValue)
            FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> FrameState -> FrameState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameState FrameState (Expr 'EWord) (Expr 'EWord)
#caller       (Addr -> Expr 'EWord
litAddr Addr
self)
            FrameState -> (FrameState -> FrameState) -> FrameState
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Word64 -> FrameState -> FrameState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas          Word64
xGas

-- | Replace a contract's code, like when CREATE returns
-- from the constructor code.
replaceCode :: Addr -> ContractCode -> EVM ()
replaceCode :: Addr -> ContractCode -> EVM ()
replaceCode Addr
target ContractCode
newCode =
  Optic' A_Lens NoIx VM (Maybe (IxValue (Map Addr Contract)))
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
-> EVM ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is VM (Maybe (IxValue (Map Addr Contract)))
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity c
-> StateT VM Identity c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
-> Optic' A_Lens NoIx VM (Maybe (IxValue (Map Addr Contract)))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 (IxValue (Map Addr Contract))) Identity ()
 -> EVM ())
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
-> EVM ()
forall a b. (a -> b) -> a -> b
$
    StateT
  (Maybe (IxValue (Map Addr Contract))) Identity (Maybe Contract)
forall s (m :: * -> *). MonadState s m => m s
get StateT
  (Maybe (IxValue (Map Addr Contract))) Identity (Maybe Contract)
-> (Maybe Contract
    -> StateT (Maybe (IxValue (Map Addr Contract))) Identity ())
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall a b.
StateT (Maybe (IxValue (Map Addr Contract))) Identity a
-> (a -> StateT (Maybe (IxValue (Map Addr Contract))) Identity b)
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Contract
now -> case Contract
now.contractcode of
        InitCode ByteString
_ Expr 'Buf
_ ->
          Maybe Contract
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe Contract
 -> StateT (Maybe (IxValue (Map Addr Contract))) Identity ())
-> (Contract -> Maybe Contract)
-> Contract
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract -> Maybe Contract
forall a. a -> Maybe a
Just (Contract
 -> StateT (Maybe (IxValue (Map Addr Contract))) Identity ())
-> Contract
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall a b. (a -> b) -> a -> b
$
            (ContractCode -> Contract
initialContract ContractCode
newCode)
              { $sel:balance:Contract :: W256
balance = Contract
now.balance
              , $sel:nonce:Contract :: W256
nonce = Contract
now.nonce
              }
        RuntimeCode RuntimeCode
_ ->
          [Char] -> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall a. HasCallStack => [Char] -> a
internalError ([Char]
 -> StateT (Maybe (IxValue (Map Addr Contract))) Identity ())
-> [Char]
-> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char]
"can't replace code of deployed contract " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
target
      Maybe Contract
Nothing ->
        [Char] -> StateT (Maybe (IxValue (Map Addr Contract))) Identity ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"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 VM
vm.state.contract ContractCode
newCode

resetState :: EVM ()
resetState :: EVM ()
resetState =
  (VM -> VM) -> EVM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((VM -> VM) -> EVM ()) -> (VM -> VM) -> EVM ()
forall a b. (a -> b) -> a -> b
$ \VM
vm -> VM
vm { $sel:result:VM :: Maybe VMResult
result = Maybe VMResult
forall a. Maybe a
Nothing
                      , $sel:frames:VM :: [Frame]
frames = []
                      , $sel:state:VM :: FrameState
state  = FrameState
blankState }

-- * VM error implementation

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

partial :: PartialExec -> EVM ()
partial :: PartialExec -> EVM ()
partial PartialExec
e = Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
#result (VMResult -> Maybe VMResult
forall a. a -> Maybe a
Just (PartialExec -> VMResult
Unfinished PartialExec
e))

wrap :: Typeable a => [Expr a] -> [SomeExpr]
wrap :: forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap = (Expr a -> SomeExpr) -> [Expr a] -> [SomeExpr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr a -> SomeExpr
forall (a :: EType). Typeable a => Expr a -> SomeExpr
SomeExpr

underrun :: EVM ()
underrun :: EVM ()
underrun = EvmError -> EVM ()
vmError EvmError
StackUnderrun

-- | A stack frame can be popped in three ways.
data FrameResult
  = FrameReturned (Expr Buf) -- ^ STOP, RETURN, or no more code
  | FrameReverted (Expr Buf) -- ^ REVERT
  | FrameErrored EvmError -- ^ Any other error
  deriving Int -> FrameResult -> [Char] -> [Char]
[FrameResult] -> [Char] -> [Char]
FrameResult -> [Char]
(Int -> FrameResult -> [Char] -> [Char])
-> (FrameResult -> [Char])
-> ([FrameResult] -> [Char] -> [Char])
-> Show FrameResult
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> FrameResult -> [Char] -> [Char]
showsPrec :: Int -> FrameResult -> [Char] -> [Char]
$cshow :: FrameResult -> [Char]
show :: FrameResult -> [Char]
$cshowList :: [FrameResult] -> [Char] -> [Char]
showList :: [FrameResult] -> [Char] -> [Char]
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 VM
oldVm.frames of
    -- Is the current frame the only one?
    [] -> do
      case FrameResult
how of
          FrameReturned Expr 'Buf
output -> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (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
$ Expr 'Buf -> VMResult
VMSuccess Expr 'Buf
output
          FrameReverted Expr 'Buf
buffer -> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (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
$ EvmError -> VMResult
VMFailure (Expr 'Buf -> EvmError
Revert Expr 'Buf
buffer)
          FrameErrored EvmError
e       -> Optic A_Lens NoIx VM VM (Maybe VMResult) (Maybe VMResult)
-> Maybe VMResult -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM (Maybe VMResult) (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
$ EvmError -> VMResult
VMFailure EvmError
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 EvmError
e ->
            EvmError -> TraceData
ErrorTrace EvmError
e
          FrameReverted Expr 'Buf
e ->
            EvmError -> TraceData
ErrorTrace (Expr 'Buf -> EvmError
Revert Expr 'Buf
e)
          FrameReturned Expr 'Buf
output ->
            Expr 'Buf -> FrameContext -> TraceData
ReturnTrace Expr 'Buf
output Frame
nextFrame.context
      -- Pop to the previous level of the debug trace stack.
      EVM ()
popTrace

      -- Pop the top frame.
      Optic A_Lens NoIx VM VM [Frame] [Frame] -> [Frame] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM [Frame] [Frame]
#frames [Frame]
remainingFrames
      -- Install the state of the frame to which we shall return.
      Optic A_Lens NoIx VM VM FrameState FrameState
-> FrameState -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens NoIx VM VM FrameState FrameState
#state Frame
nextFrame.state

      -- When entering a call, the gas allowance is counted as burned
      -- in advance; this unburns the remainder and adds it to the
      -- parent frame.
      let remainingGas :: Word64
remainingGas = VM
oldVm.state.gas
          reclaimRemainingGasAllowance :: EVM ()
reclaimRemainingGasAllowance = do
            Optic A_Lens NoIx VM VM Word64 Word64
-> (Word64 -> Word64) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx VM VM Word64 Word64
#burned (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
subtract Word64
remainingGas)
            Optic A_Lens NoIx VM VM Word64 Word64
-> (Word64 -> Word64) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#gas) (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
remainingGas)

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

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

          -- Excerpt K.1. from the yellow paper:
          -- K.1. Deletion of an Account Despite Out-of-gas.
          -- At block 2675119, in the transaction 0xcf416c536ec1a19ed1fb89e4ec7ffb3cf73aa413b3aa9b77d60e4fd81a4296ba,
          -- an account at address 0x03 was called and an out-of-gas occurred during the call.
          -- Against the equation (197), this added 0x03 in the set of touched addresses, and this transaction turned σ[0x03] into ∅.

          -- In other words, we special case address 0x03 and keep it in the set of touched accounts during revert
          [Addr]
touched <- Optic' A_Lens NoIx VM [Addr] -> StateT VM Identity [Addr]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate Optic A_Lens NoIx VM VM SubState SubState
-> Optic A_Lens NoIx SubState SubState [Addr] [Addr]
-> Optic' A_Lens NoIx VM [Addr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SubState SubState [Addr] [Addr]
#touchedAccounts)

          let
            substate'' :: SubState
substate'' = Optic A_Lens NoIx SubState SubState [Addr] [Addr]
-> ([Addr] -> [Addr]) -> SubState -> SubState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx SubState SubState [Addr] [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
3 ==) [Addr]
touched)) SubState
substate'
            (Map Addr Contract
contractsReversion, Expr 'Storage
storageReversion) = (Map Addr Contract, Expr 'Storage)
reversion
            revertContracts :: EVM ()
revertContracts = Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Map Addr Contract -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts) Map Addr Contract
contractsReversion
            revertStorage :: EVM ()
revertStorage = Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> Expr 'Storage -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#storage) Expr 'Storage
storageReversion
            revertSubstate :: EVM ()
revertSubstate  = Optic A_Lens NoIx VM VM SubState SubState -> SubState -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState SubState
#substate) SubState
substate''

          case FrameResult
how of
            -- Case 1: Returning from a call?
            FrameReturned Expr 'Buf
output -> do
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
output
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
output Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
              EVM ()
reclaimRemainingGasAllowance
              W256 -> EVM ()
push W256
1

            -- Case 2: Reverting during a call?
            FrameReverted Expr 'Buf
output -> do
              EVM ()
revertContracts
              EVM ()
revertStorage
              EVM ()
revertSubstate
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
output
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
output Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
              EVM ()
reclaimRemainingGasAllowance
              W256 -> EVM ()
push W256
0

            -- Case 3: Error during a call?
            FrameErrored EvmError
_ -> do
              EVM ()
revertContracts
              EVM ()
revertStorage
              EVM ()
revertSubstate
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
              W256 -> EVM ()
push W256
0
        -- Or were we creating?
        CreationContext Addr
_ Expr 'EWord
_ Map Addr Contract
reversion SubState
substate' -> do
          Addr
creator <- Optic' A_Lens NoIx VM Addr -> StateT VM Identity Addr
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Addr Addr
-> Optic' A_Lens NoIx VM Addr
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Addr Addr
#contract)
          let
            createe :: Addr
createe = VM
oldVm.state.contract
            revertContracts :: EVM ()
revertContracts = Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Map Addr Contract -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts) Map Addr Contract
reversion'
            revertSubstate :: EVM ()
revertSubstate  = Optic A_Lens NoIx VM VM SubState SubState -> SubState -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM TxState TxState
#tx Optic A_Lens NoIx VM VM TxState TxState
-> Optic A_Lens NoIx TxState TxState SubState SubState
-> Optic A_Lens NoIx VM VM SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TxState TxState SubState 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 (Optic A_Lens NoIx Contract Contract W256 W256
-> (W256 -> W256) -> Contract -> Contract
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Contract Contract W256 W256
#nonce (W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
1)) Addr
creator) Map Addr Contract
reversion

          case FrameResult
how of
            -- Case 4: Returning during a creation?
            FrameReturned Expr 'Buf
output -> do
              let onContractCode :: ContractCode -> EVM ()
onContractCode ContractCode
contractCode = do
                    Addr -> ContractCode -> EVM ()
replaceCode Addr
createe ContractCode
contractCode
                    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
                    EVM ()
reclaimRemainingGasAllowance
                    W256 -> EVM ()
push (Addr -> W256
forall target source. From source target => source -> target
into Addr
createe)
              case Expr 'Buf
output of
                ConcreteBuf ByteString
bs ->
                  ContractCode -> EVM ()
onContractCode (ContractCode -> EVM ()) -> ContractCode -> EVM ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
bs)
                Expr 'Buf
_ ->
                  case Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList Expr 'Buf
output of
                    Maybe (Vector (Expr 'Byte))
Nothing -> PartialExec -> EVM ()
partial (PartialExec -> EVM ()) -> PartialExec -> EVM ()
forall a b. (a -> b) -> a -> b
$
                      Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg
                        VM
oldVm.state.pc
                        [Char]
"runtime code cannot have an abstract length"
                        ([Expr 'Buf] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
output])
                    Just Vector (Expr 'Byte)
newCode -> do
                      ContractCode -> EVM ()
onContractCode (ContractCode -> EVM ()) -> ContractCode -> EVM ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
newCode)

            -- Case 5: Reverting during a creation?
            FrameReverted Expr 'Buf
output -> do
              EVM ()
revertContracts
              EVM ()
revertSubstate
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
output
              EVM ()
reclaimRemainingGasAllowance
              W256 -> EVM ()
push W256
0

            -- Case 6: Error during a creation?
            FrameErrored EvmError
_ -> do
              EVM ()
revertContracts
              EVM ()
revertSubstate
              Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
              W256 -> EVM ()
push W256
0


-- * Memory helpers

accessUnboundedMemoryRange
  :: Word64
  -> Word64
  -> EVM ()
  -> EVM ()
accessUnboundedMemoryRange :: Word64 -> Word64 -> EVM () -> EVM ()
accessUnboundedMemoryRange Word64
_ Word64
0 EVM ()
continue = EVM ()
continue
accessUnboundedMemoryRange Word64
f Word64
l EVM ()
continue = do
  Word64
m0 <- Optic A_Lens NoIx VM VM Word64 Word64 -> StateT VM Identity Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#memorySize)
  FeeSchedule Word64
fees <- (VM -> FeeSchedule Word64)
-> StateT VM Identity (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
  let m1 :: Word64
m1 = Word64
32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
m0 (Word64
f Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l)) Word64
32
  Word64 -> EVM () -> EVM ()
burn (FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m0) (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
    Optic A_Lens NoIx VM VM Word64 Word64 -> Word64 -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Word64 Word64
-> Optic A_Lens NoIx VM VM Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Word64 Word64
#memorySize) Word64
m1
    EVM ()
continue

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

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

copyBytesToMemory
  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM ()
copyBytesToMemory :: Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
xOffset Expr 'EWord
yOffset =
  if Expr 'EWord
size Expr 'EWord -> Expr 'EWord -> Bool
forall a. Eq a => a -> a -> Bool
== W256 -> Expr 'EWord
Lit W256
0 then EVM ()
forall (m :: * -> *). Monad m => m ()
noop
  else do
    Expr 'Buf
mem <- Optic' A_Lens NoIx VM (Expr 'Buf) -> StateT VM Identity (Expr 'Buf)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory) (Expr 'Buf -> EVM ()) -> Expr 'Buf -> EVM ()
forall a b. (a -> b) -> a -> b
$
      Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
xOffset Expr 'EWord
yOffset Expr 'EWord
size Expr 'Buf
bs Expr 'Buf
mem

copyCallBytesToMemory
  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM ()
copyCallBytesToMemory :: Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
xOffset Expr 'EWord
yOffset =
  if Expr 'EWord
size Expr 'EWord -> Expr 'EWord -> Bool
forall a. Eq a => a -> a -> Bool
== W256 -> Expr 'EWord
Lit W256
0 then EVM ()
forall (m :: * -> *). Monad m => m ()
noop
  else do
    Expr 'Buf
mem <- Optic' A_Lens NoIx VM (Expr 'Buf) -> StateT VM Identity (Expr 'Buf)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory)
    Optic' A_Lens NoIx VM (Expr 'Buf) -> Expr 'Buf -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
-> Optic' A_Lens NoIx VM (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState (Expr 'Buf) (Expr 'Buf)
#memory) (Expr 'Buf -> EVM ()) -> Expr 'Buf -> EVM ()
forall a b. (a -> b) -> a -> b
$
      Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
xOffset Expr 'EWord
yOffset (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.min Expr 'EWord
size (Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
bs)) Expr 'Buf
bs Expr 'Buf
mem

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

-- * Tracing

withTraceLocation :: TraceData -> EVM Trace
withTraceLocation :: TraceData -> EVM Trace
withTraceLocation TraceData
x = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  let this :: Contract
this = Maybe Contract -> Contract
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Contract -> Contract) -> Maybe Contract -> Contract
forall a b. (a -> b) -> a -> b
$ VM -> Maybe Contract
currentContract VM
vm
  Trace -> EVM Trace
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace
    { $sel:tracedata:Trace :: TraceData
tracedata = TraceData
x
    , $sel:contract:Trace :: Contract
contract = Contract
this
    , $sel:opIx:Trace :: Int
opIx = 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
$ Contract
this.opIxMap Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
SV.!? VM
vm.state.pc
    }

pushTrace :: TraceData -> EVM ()
pushTrace :: TraceData -> EVM ()
pushTrace TraceData
x = do
  Trace
trace <- TraceData -> EVM Trace
withTraceLocation TraceData
x
  Optic A_Lens NoIx VM VM (TreePos Empty Trace) (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx VM VM (TreePos Empty Trace) (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 -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t

insertTrace :: TraceData -> EVM ()
insertTrace :: TraceData -> EVM ()
insertTrace TraceData
x = do
  Trace
trace <- TraceData -> EVM Trace
withTraceLocation TraceData
x
  Optic A_Lens NoIx VM VM (TreePos Empty Trace) (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx VM VM (TreePos Empty Trace) (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 -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t

popTrace :: EVM ()
popTrace :: EVM ()
popTrace =
  Optic A_Lens NoIx VM VM (TreePos Empty Trace) (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx VM VM (TreePos Empty Trace) (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 -> [Char] -> TreePos Empty Trace
forall a. HasCallStack => [Char] -> a
internalError [Char]
"internal internalError(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 :: forall a. 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 VM
vm = TreePos Empty Trace -> Forest Trace
forall a. TreePos Empty a -> Forest a
zipperRootForest VM
vm.traces

traceForest' :: Expr End -> Forest Trace
traceForest' :: Expr 'End -> Forest Trace
traceForest' (Success [Prop]
_ (Traces Forest Trace
f Map Addr Contract
_) Expr 'Buf
_ Expr 'Storage
_) = Forest Trace
f
traceForest' (Partial [Prop]
_ (Traces Forest Trace
f Map Addr Contract
_) PartialExec
_) = Forest Trace
f
traceForest' (Failure [Prop]
_ (Traces Forest Trace
f Map Addr Contract
_) EvmError
_) = Forest Trace
f
traceForest' (ITE {}) = [Char] -> Forest Trace
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: ITE does not contain a trace"
traceForest' (GVar {}) = [Char] -> Forest Trace
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: Unexpected GVar"

traceContext :: Expr End -> Map Addr Contract
traceContext :: Expr 'End -> Map Addr Contract
traceContext (Success [Prop]
_ (Traces Forest Trace
_ Map Addr Contract
c) Expr 'Buf
_ Expr 'Storage
_) = Map Addr Contract
c
traceContext (Partial [Prop]
_ (Traces Forest Trace
_ Map Addr Contract
c) PartialExec
_) = Map Addr Contract
c
traceContext (Failure [Prop]
_ (Traces Forest Trace
_ Map Addr Contract
c) EvmError
_) = Map Addr Contract
c
traceContext (ITE {}) = [Char] -> Map Addr Contract
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: ITE does not contain a trace"
traceContext (GVar {}) = [Char] -> Map Addr Contract
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: Unexpected GVar"

traceTopLog :: [Expr Log] -> EVM ()
traceTopLog :: [Expr 'Log] -> EVM ()
traceTopLog [] = EVM ()
forall (m :: * -> *). Monad m => m ()
noop
traceTopLog ((LogEntry Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics) : [Expr 'Log]
_) = do
  Trace
trace <- TraceData -> EVM Trace
withTraceLocation (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> TraceData
EventTrace Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics)
  Optic A_Lens NoIx VM VM (TreePos Empty Trace) (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens NoIx VM VM (TreePos Empty Trace) (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 (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 -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t)
traceTopLog ((GVar GVar 'Log
_) : [Expr 'Log]
_) = [Char] -> EVM ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected global variable"

-- * Stack manipulation

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

pushSym :: Expr EWord -> EVM ()
pushSym :: Expr 'EWord -> EVM ()
pushSym Expr 'EWord
x = Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack Optic' A_Lens NoIx VM [Expr 'EWord]
-> ([Expr 'EWord] -> [Expr 'EWord]) -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EWord
x :)

stackOp1
  :: (?op :: Word8)
  => Word64
  -> ((Expr EWord) -> (Expr EWord))
  -> EVM ()
stackOp1 :: (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
cost Expr 'EWord -> Expr 'EWord
f =
  Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT VM Identity [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) StateT VM Identity [Expr 'EWord]
-> ([Expr 'EWord] -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Expr 'EWord
x:[Expr 'EWord]
xs ->
      Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
        EVM ()
(?op::Word8) => EVM ()
next
        let !y :: Expr 'EWord
y = Expr 'EWord -> Expr 'EWord
f Expr 'EWord
x
        (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Expr 'EWord
y Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      EVM ()
underrun

stackOp2
  :: (?op :: Word8)
  => Word64
  -> (((Expr EWord), (Expr EWord)) -> (Expr EWord))
  -> EVM ()
stackOp2 :: (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
cost (Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f =
  Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT VM Identity [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) StateT VM Identity [Expr 'EWord]
-> ([Expr 'EWord] -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs ->
      Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
        EVM ()
(?op::Word8) => EVM ()
next
        (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= (Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f (Expr 'EWord
x, Expr 'EWord
y) Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      EVM ()
underrun

stackOp3
  :: (?op :: Word8)
  => Word64
  -> (((Expr EWord), (Expr EWord), (Expr EWord)) -> (Expr EWord))
  -> EVM ()
stackOp3 :: (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
cost (Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f =
  Optic' A_Lens NoIx VM [Expr 'EWord]
-> StateT VM Identity [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) StateT VM Identity [Expr 'EWord]
-> ([Expr 'EWord] -> EVM ()) -> EVM ()
forall a b.
StateT VM Identity a
-> (a -> StateT VM Identity b) -> StateT VM Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Expr 'EWord
x:Expr 'EWord
y:Expr 'EWord
z:[Expr 'EWord]
xs ->
      Word64 -> EVM () -> EVM ()
burn Word64
cost (EVM () -> EVM ()) -> EVM () -> EVM ()
forall a b. (a -> b) -> a -> b
$ do
      EVM ()
(?op::Word8) => EVM ()
next
      (Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
-> Optic' A_Lens NoIx VM [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState [Expr 'EWord] [Expr 'EWord]
#stack) Optic' A_Lens NoIx VM [Expr 'EWord] -> [Expr 'EWord] -> EVM ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= (Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f (Expr 'EWord
x, Expr 'EWord
y, Expr 'EWord
z) Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      EVM ()
underrun

-- * Bytecode data functions

use' :: (VM -> a) -> EVM a
use' :: forall a. (VM -> a) -> EVM a
use' VM -> a
f = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  a -> EVM a
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VM -> a
f VM
vm)

checkJump :: Int -> [Expr EWord] -> EVM ()
checkJump :: Int -> [Expr 'EWord] -> EVM ()
checkJump Int
x [Expr 'EWord]
xs = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  case VM -> Int -> Bool
isValidJumpDest VM
vm Int
x of
    Bool
True -> do
      #state % #stack .= xs
      #state % #pc .= x
    Bool
False -> EvmError -> EVM ()
vmError EvmError
BadJumpDestination

isValidJumpDest :: VM -> Int -> Bool
isValidJumpDest :: VM -> Int -> Bool
isValidJumpDest VM
vm Int
x = let
    code :: ContractCode
code = VM
vm.state.code
    self :: Addr
self = VM
vm.state.codeContract
    contract :: Contract
contract = Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe
      ([Char] -> Contract
forall a. HasCallStack => [Char] -> a
internalError [Char]
"self not found in current contracts")
      (Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
self VM
vm.env.contracts)
    op :: Maybe Word8
op = case ContractCode
code of
      InitCode ByteString
ops Expr 'Buf
_ -> ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
ops Int
x
      RuntimeCode (ConcreteRuntimeCode ByteString
ops) -> ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
ops Int
x
      RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) -> Vector (Expr 'Byte)
ops Vector (Expr 'Byte) -> Int -> Maybe (Expr 'Byte)
forall a. Vector a -> Int -> Maybe a
V.!? Int
x Maybe (Expr 'Byte) -> (Expr 'Byte -> Maybe Word8) -> Maybe Word8
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr 'Byte -> Maybe Word8
maybeLitByte
  in case Maybe Word8
op of
       Maybe Word8
Nothing -> Bool
False
       Just Word8
b -> Word8
0x5b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b Bool -> Bool -> Bool
&& GenericOp (Expr 'EWord)
forall a. GenericOp a
OpJumpdest GenericOp (Expr 'EWord) -> GenericOp (Expr 'EWord) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, GenericOp (Expr 'EWord)) -> GenericOp (Expr 'EWord)
forall a b. (a, b) -> b
snd (Contract
contract.codeOps Vector (Int, GenericOp (Expr 'EWord))
-> Int -> (Int, GenericOp (Expr 'EWord))
forall a. Vector a -> Int -> a
V.! (Contract
contract.opIxMap Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
SV.! Int
x))

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 target source. From source target => source -> target
into 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

--  i of the resulting vector contains the operation index for
-- the program counter value i.  This is needed because source map
-- entries are per operation, not per byte.
mkOpIxMap :: ContractCode -> SV.Vector Int
mkOpIxMap :: ContractCode -> Vector Int
mkOpIxMap (InitCode ByteString
conc Expr 'Buf
_)
  = (forall s. ST s (MVector s Int)) -> Vector Int
forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
SV.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)
SV.new (ByteString -> Int
BS.length ByteString
conc) ST s (MVector s Int)
-> (MVector s Int -> ST s (MVector s Int)) -> ST s (MVector s Int)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
      -- Loop over the byte string accumulating a vector-mutating action.
      -- This is somewhat obfuscated, but should be fast.
      let (Word8
_, Int
_, Int
_, ST s ()
m) = ((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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ByteString
conc
      in ST s ()
m ST s () -> ST s (MVector s Int) -> ST s (MVector s Int)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Int -> ST s (MVector s Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 a b. m a -> m b -> m b
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 ()
SV.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 a b. m a -> m b -> m b
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 ()
SV.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 a b. m a -> m b -> m b
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 ()
SV.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 a b. m a -> m b -> m b
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 ()
SV.write MVector (PrimState m) a
v Int
i a
j)

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

mkOpIxMap (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops))
  = (forall s. ST s (MVector s Int)) -> Vector Int
forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
SV.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)
SV.new (Vector (Expr 'Byte) -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops) ST s (MVector s Int)
-> (MVector s Int -> ST s (MVector s Int)) -> ST s (MVector s Int)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
      let (Word8
_, Int
_, Int
_, ST s ()
m) = ((Word8, Int, Int, ST s ())
 -> Expr 'Byte -> (Word8, Int, Int, ST s ()))
-> (Word8, Int, Int, ST s ())
-> [Expr 'Byte]
-> (Word8, Int, Int, ST s ())
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (MVector (PrimState (ST s)) Int
-> (Word8, Int, Int, ST s ())
-> Expr 'Byte
-> (Word8, Int, Int, ST s ())
forall {m :: * -> *} {a} {a}.
(PrimMonad m, Storable a, Num a, Show a) =>
MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector s Int
MVector (PrimState (ST s)) Int
v) (Word8
0, Int
0, Int
0, () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ([Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym ([Expr 'Byte] -> [Expr 'Byte]) -> [Expr 'Byte] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> [Expr 'Byte]
forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops)
      in ST s ()
m ST s () -> ST s (MVector s Int) -> ST s (MVector s Int)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Int -> ST s (MVector s Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
      where
        go :: MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector (PrimState m) a
v (Word8
0, !Int
i, !a
j, !m a
m) Expr 'Byte
x = case Expr 'Byte -> Maybe Word8
maybeLitByte Expr 'Byte
x of
          Just Word8
x' -> if 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
            -- start of PUSH op --
                     then (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, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
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 ()
SV.write MVector (PrimState m) a
v Int
i a
j)
            -- other data --
                     else (Word8
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 a b. m a -> m b -> m b
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 ()
SV.write MVector (PrimState m) a
v Int
i a
j)
          Maybe Word8
_ -> [Char] -> (Word8, Int, a, m ())
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> (Word8, Int, a, m ()))
-> [Char] -> (Word8, Int, a, m ())
forall a b. (a -> b) -> a -> b
$ [Char]
"cannot analyze symbolic code:\nx: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Expr 'Byte -> [Char]
forall a. Show a => a -> [Char]
show Expr 'Byte
x [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" i: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" j: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
j

        go MVector (PrimState m) a
v (Word8
1, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
          {- End of PUSH op. -}   (Word8
0,            Int
i 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 a b. m a -> m b -> m b
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 ()
SV.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (Word8
n, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
          {- PUSH data. -}        (Word8
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
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 a b. m a -> m b -> m b
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 ()
SV.write MVector (PrimState m) a
v Int
i a
j)


vmOp :: VM -> Maybe Op
vmOp :: VM -> Maybe (GenericOp (Expr 'EWord))
vmOp VM
vm =
  let i :: Int
i  = VM
vm VM -> Optic A_Lens NoIx VM VM Int Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic A_Lens NoIx FrameState FrameState Int Int
-> Optic A_Lens NoIx VM VM Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState Int Int
#pc
      code' :: ContractCode
code' = VM
vm VM
-> Optic A_Lens NoIx VM VM ContractCode ContractCode
-> ContractCode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx VM VM FrameState FrameState
#state Optic A_Lens NoIx VM VM FrameState FrameState
-> Optic
     A_Lens NoIx FrameState FrameState ContractCode ContractCode
-> Optic A_Lens NoIx VM VM ContractCode ContractCode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx FrameState FrameState ContractCode ContractCode
#code
      (Word8
op, [Expr 'Byte]
pushdata) = case ContractCode
code' of
        InitCode ByteString
xs' Expr 'Buf
_ ->
          (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, (Word8 -> Expr 'Byte) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte ([Word8] -> [Expr 'Byte]) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        RuntimeCode (ConcreteRuntimeCode ByteString
xs') ->
          (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, (Word8 -> Expr 'Byte) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte ([Word8] -> [Expr 'Byte]) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
xs') ->
          ( Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected symbolic code") (Maybe Word8 -> Word8)
-> (Expr 'Byte -> Maybe Word8) -> Expr 'Byte -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Byte -> Maybe Word8
maybeLitByte (Expr 'Byte -> Word8) -> Expr 'Byte -> Word8
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
xs' Vector (Expr 'Byte) -> Int -> Expr 'Byte
forall a. Vector a -> Int -> a
V.! Int
i , Vector (Expr 'Byte) -> [Expr 'Byte]
forall a. Vector a -> [a]
V.toList (Vector (Expr 'Byte) -> [Expr 'Byte])
-> Vector (Expr 'Byte) -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a. Int -> Vector a -> Vector a
V.drop Int
i Vector (Expr 'Byte)
xs')
  in if (ContractCode -> Int
opslen ContractCode
code' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i)
     then Maybe (GenericOp (Expr 'EWord))
forall a. Maybe a
Nothing
     else GenericOp (Expr 'EWord) -> Maybe (GenericOp (Expr 'EWord))
forall a. a -> Maybe a
Just (Word8 -> [Expr 'Byte] -> GenericOp (Expr 'EWord)
readOp Word8
op [Expr 'Byte]
pushdata)

vmOpIx :: VM -> Maybe Int
vmOpIx :: VM -> Maybe Int
vmOpIx VM
vm =
  do Contract
self <- VM -> Maybe Contract
currentContract VM
vm
     Contract
self.opIxMap Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
SV.!? VM
vm.state.pc

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

-- * Gas cost calculation helpers

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

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

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

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

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

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

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

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

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

codeloc :: EVM CodeLocation
codeloc :: EVM CodeLocation
codeloc = do
  VM
vm <- StateT VM Identity VM
forall s (m :: * -> *). MonadState s m => m s
get
  CodeLocation -> EVM CodeLocation
forall a. a -> StateT VM Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VM
vm.state.contract, VM
vm.state.pc)

-- * Arithmetic

ceilDiv :: (Num a, Integral a) => a -> a -> a
ceilDiv :: forall a. (Num a, Integral a) => 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 :: forall a. (Num a, Integral a) => 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 :: forall b. FiniteBits b => 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