{-# Language ImplicitParams #-}
{-# Language UndecidableInstances #-}
{-# Language ScopedTypeVariables #-}
{-# Language GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module EVM where
import Prelude hiding (log, exponent, GT, LT)
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 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 = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:memory:FrameState :: Expr 'Buf
memory = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:memorySize:FrameState :: Word64
memorySize = Word64
0
, $sel:calldata:FrameState :: Expr 'Buf
calldata = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:callvalue:FrameState :: Expr 'EWord
callvalue = W256 -> Expr 'EWord
Lit W256
0
, $sel:caller:FrameState :: Expr 'EWord
caller = W256 -> Expr 'EWord
Lit W256
0
, $sel:gas:FrameState :: Word64
gas = Word64
0
, $sel:returndata:FrameState :: Expr 'Buf
returndata = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:static:FrameState :: Bool
static = Bool
False
}
bytecode :: Getter Contract (Expr Buf)
bytecode :: Getter Contract (Expr 'Buf)
bytecode = forall (a :: OpticKind). IsLabel "contractcode" a => a
#contractcode forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (s :: OpticKind) (a :: OpticKind). (s -> a) -> Getter s a
to ContractCode -> Expr 'Buf
f
where f :: ContractCode -> Expr 'Buf
f (InitCode ByteString
_ Expr 'Buf
_) = forall (a :: OpticKind). 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
currentContract :: VM -> Maybe Contract
currentContract :: VM -> Maybe Contract
currentContract VM
vm =
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup VM
vm.state.codeContract VM
vm.env.contracts
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 = forall (a :: OpticKind). Ord a => [a] -> Set a
fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Addr
txorigin, Addr
txtoAddr, VMOpts
o.coinbase] forall (a :: OpticKind). [a] -> [a] -> [a]
++ [Addr
1..Addr
9] forall (a :: OpticKind). [a] -> [a] -> [a]
++ (forall (k :: OpticKind) (a :: OpticKind). Map k a -> [k]
Map.keys Map Addr [W256]
txaccessList)
initialAccessedStorageKeys :: Set (Addr, W256)
initialAccessedStorageKeys = forall (a :: OpticKind). Ord a => [a] -> Set a
fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (t :: OpticKind -> OpticKind) (m :: OpticKind)
(a :: OpticKind).
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry (forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (,))) (forall (k :: OpticKind) (a :: OpticKind). 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 = forall (a :: OpticKind). Maybe a
Nothing
, $sel:frames:VM :: [Frame]
frames = forall (a :: OpticKind). 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 forall (a :: OpticKind). Monoid a => a
mempty [Addr]
touched Set Addr
initialAccessedAddrs Set (Addr, W256)
initialAccessedStorageKeys forall (a :: OpticKind). Monoid a => a
mempty
, $sel:isCreate:TxState :: Bool
isCreate = VMOpts
o.create
, $sel:txReversion:TxState :: Map Addr Contract
txReversion = forall (k :: OpticKind) (a :: OpticKind).
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 = forall (a :: OpticKind). 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 = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:memory:FrameState :: Expr 'Buf
memory = forall (a :: OpticKind). 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 = forall (a :: OpticKind) (b :: OpticKind). (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 = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:static:FrameState :: Bool
static = Bool
False
}
, $sel:env:VM :: Env
env = Env
{ $sel:sha3Crack:Env :: Map W256 ByteString
sha3Crack = forall (a :: OpticKind). Monoid a => a
mempty
, $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 = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:contracts:Env :: Map Addr Contract
contracts = forall (k :: OpticKind) (a :: OpticKind).
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 forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty
, $sel:burned:VM :: Word64
burned = Word64
0
, $sel:constraints:VM :: [Prop]
constraints = forall (a :: OpticKind) (b :: OpticKind). (a, b) -> b
snd VMOpts
o.calldata
, $sel:keccakEqs:VM :: [Prop]
keccakEqs = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:iterations:VM :: Map CodeLocation (Int, [Expr 'EWord])
iterations = forall (a :: OpticKind). Monoid a => a
mempty
, $sel:allowFFI:VM :: Bool
allowFFI = VMOpts
o.allowFFI
, $sel:overrideCaller:VM :: Maybe Addr
overrideCaller = forall (a :: OpticKind). Maybe a
Nothing
}
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
next :: (?op :: Word8) => EVM ()
next :: (?op::Word8) => EVM ()
next = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "pc" a => a
#pc) (forall (a :: OpticKind). Num a => a -> a -> a
+ (Word8 -> Int
opSize ?op::Word8
?op))
exec1 :: EVM ()
exec1 :: EVM ()
exec1 = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let
mem :: Expr 'Buf
mem = VM
vm.state.memory
stk :: [Expr 'EWord]
stk = VM
vm.state.stack
self :: Addr
self = VM
vm.state.contract
this :: Contract
this = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: state contract") (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup Addr
self VM
vm.env.contracts)
fees :: FeeSchedule Word64
fees@FeeSchedule {Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_initcodeword :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
..} = VM
vm.block.schedule
doStop :: EVM ()
doStop = FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned forall (a :: OpticKind). Monoid a => a
mempty)
if Addr
self forall (a :: OpticKind). Ord a => a -> a -> Bool
> Addr
0x0 Bool -> Bool -> Bool
&& Addr
self forall (a :: OpticKind). Ord a => a -> a -> Bool
<= Addr
0x9 then do
let ?op = Word8
0x00
case Expr 'Buf -> Expr 'EWord
bufLength VM
vm.state.calldata of
Lit W256
calldatasize -> do
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm.state.calldata (W256 -> Expr 'EWord
Lit W256
calldatasize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
0)
(?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
self VM
vm.state.gas W256
0 W256
calldatasize W256
0 W256
0 []
VM
vmx <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
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 forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
_ -> do
Addr -> EVM ()
touchAccount Addr
self
Expr 'Buf
out <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata)
FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
out)
Expr 'EWord
e -> PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vmx.state.pc [Char]
"precompile returned a symbolic value" (forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
e])
[Expr 'EWord]
_ ->
EVM ()
underrun
Expr 'EWord
e -> PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
"cannot call precompiles with symbolic data" (forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
e])
else if VM
vm.state.pc forall (a :: OpticKind). Ord a => a -> a -> Bool
>= ContractCode -> Int
opslen VM
vm.state.code
then EVM ()
doStop
else do
let ?op = case VM
vm.state.code of
InitCode ByteString
conc Expr 'Buf
_ -> HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
conc VM
vm.state.pc
RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
bs VM
vm.state.pc
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"could not analyze symbolic code") forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Expr 'Byte -> Maybe Word8
maybeLitByte forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops forall (a :: OpticKind). Vector a -> Int -> a
V.! VM
vm.state.pc
case Word8 -> GenericOp Word8
getOp(?op::Word8
?op) of
GenericOp Word8
OpPush0 -> do
Int -> EVM () -> EVM ()
limitStack Int
1 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
Expr 'EWord -> EVM ()
pushSym (W256 -> Expr 'EWord
Lit W256
0)
OpPush Word8
n' -> do
let n :: Int
n = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
n'
!xs :: Expr 'EWord
xs = case VM
vm.state.code of
InitCode ByteString
conc Expr 'Buf
_ -> W256 -> Expr 'EWord
Lit forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
padRight Int
n forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (Int -> ByteString -> ByteString
BS.drop (Int
1 forall (a :: OpticKind). Num a => a -> a -> a
+ VM
vm.state.pc) ByteString
conc)
RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> W256 -> Expr 'EWord
Lit forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
1 forall (a :: OpticKind). Num a => a -> a -> a
+ VM
vm.state.pc) ByteString
bs
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
let bytes :: Vector (Expr 'Byte)
bytes = forall (a :: OpticKind). Int -> Vector a -> Vector a
V.take Int
n forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Int -> Vector a -> Vector a
V.drop (Int
1 forall (a :: OpticKind). Num a => a -> a -> a
+ VM
vm.state.pc) Vector (Expr 'Byte)
ops
in Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
0) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
padLeft' Int
32 Vector (Expr 'Byte)
bytes
Int -> EVM () -> EVM ()
limitStack Int
1 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
Expr 'EWord -> EVM ()
pushSym Expr 'EWord
xs
OpDup Word8
i ->
case forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
i forall (a :: OpticKind). 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
Expr 'EWord -> EVM ()
pushSym Expr 'EWord
y
OpSwap Word8
i ->
if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [Expr 'EWord]
stk forall (a :: OpticKind). Ord a => a -> a -> Bool
< (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
i) forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1
then EVM ()
underrun
else
Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Expr 'EWord]
0) ([Expr 'EWord]
stk forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
(a :: OpticKind).
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
i))
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
i)) ([Expr 'EWord]
stk forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
(a :: OpticKind).
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Int
0)
OpLog Word8
n ->
EVM () -> EVM ()
notStatic forall (a :: OpticKind) b. (a -> b) -> a -> b
$
case [Expr 'EWord]
stk of
(Expr 'EWord
xOffset':Expr 'EWord
xSize':[Expr 'EWord]
xs) ->
if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [Expr 'EWord]
xs forall (a :: OpticKind). Ord a => a -> a -> Bool
< (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
n)
then EVM ()
underrun
else
(Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM ()) -> EVM ()
forceConcrete2 (Expr 'EWord
xOffset', Expr 'EWord
xSize') [Char]
"LOG" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) -> do
let ([Expr 'EWord]
topics, [Expr 'EWord]
xs') = forall (a :: OpticKind). Int -> [a] -> ([a], [a])
splitAt (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral Word8
n) [Expr 'EWord]
xs
bytes :: Expr 'Buf
bytes = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
logs' :: [Expr 'Log]
logs' = (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> Expr 'Log
LogEntry (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'Buf
bytes [Expr 'EWord]
topics) forall (a :: OpticKind). a -> [a] -> [a]
: VM
vm.logs
Word64 -> EVM () -> EVM ()
burn (Word64
g_log forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_logdata forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xSize) forall (a :: OpticKind). Num a => a -> a -> a
+ forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word8
n forall (a :: OpticKind). Num a => a -> a -> a
* Word64
g_logtopic) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
[Expr 'Log] -> EVM ()
traceTopLog [Expr 'Log]
logs'
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs'
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "logs" a => a
#logs [Expr 'Log]
logs'
[Expr 'EWord]
_ ->
EVM ()
underrun
GenericOp Word8
OpStop -> EVM ()
doStop
GenericOp Word8
OpAdd -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add)
GenericOp Word8
OpMul -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mul)
GenericOp Word8
OpSub -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sub)
GenericOp Word8
OpDiv -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.div)
GenericOp Word8
OpSdiv -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sdiv)
GenericOp Word8
OpMod -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mod)
GenericOp Word8
OpSmod -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.smod)
GenericOp Word8
OpAddmod -> (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
g_mid (forall (a :: OpticKind) (b :: OpticKind). Curry a b => b -> a
uncurryN Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.addmod)
GenericOp Word8
OpMulmod -> (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
g_mid (forall (a :: OpticKind) (b :: OpticKind). Curry a b => b -> a
uncurryN Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mulmod)
GenericOp Word8
OpLt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt)
GenericOp Word8
OpGt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt)
GenericOp Word8
OpSlt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.slt)
GenericOp Word8
OpSgt -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sgt)
GenericOp Word8
OpEq -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.eq)
GenericOp Word8
OpIszero -> (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_verylow Expr 'EWord -> Expr 'EWord
Expr.iszero
GenericOp Word8
OpAnd -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.and)
GenericOp Word8
OpOr -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.or)
GenericOp Word8
OpXor -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.xor)
GenericOp Word8
OpNot -> (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_verylow Expr 'EWord -> Expr 'EWord
Expr.not
GenericOp Word8
OpByte -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (\(Expr 'EWord
i, Expr 'EWord
w) -> Expr 'Byte -> Expr 'EWord
Expr.padByte forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> Expr 'Byte
Expr.indexWord Expr 'EWord
i Expr 'EWord
w)
GenericOp Word8
OpShl -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.shl)
GenericOp Word8
OpShr -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.shr)
GenericOp Word8
OpSar -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_verylow (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sar)
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\W256
xOffset -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
xSize' [Char]
"sha3 size must be concrete" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
xSize ->
Word64 -> EVM () -> EVM ()
burn (Word64
g_sha3 forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_sha3word forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xSize) Word64
32) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(Expr 'EWord
hash, Map W256 ByteString
invMap) <- case Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm of
ConcreteBuf ByteString
bs -> do
let hash' :: W256
hash' = ByteString -> W256
keccak' ByteString
bs
[Prop]
eqs <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (a :: OpticKind). IsLabel "keccakEqs" a => a
#keccakEqs
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "keccakEqs" a => a
#keccakEqs forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
PEq (W256 -> Expr 'EWord
Lit W256
hash') (Expr 'Buf -> Expr 'EWord
Keccak (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs))forall (a :: OpticKind). a -> [a] -> [a]
:[Prop]
eqs
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (W256 -> Expr 'EWord
Lit W256
hash', forall (k :: OpticKind) (a :: OpticKind). k -> a -> Map k a
Map.singleton W256
hash' ByteString
bs)
Expr 'Buf
buf -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Expr 'Buf -> Expr 'EWord
Keccak Expr 'Buf
buf, forall (a :: OpticKind). Monoid a => a
mempty)
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (Expr 'EWord
hash forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "sha3Crack" a => a
#sha3Crack) (forall (a :: OpticKind). Semigroup a => a -> a -> a
(<>) Map W256 ByteString
invMap)
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpAddress ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Word64 -> EVM () -> EVM ()
burn Word64
g_base ((?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
self))
GenericOp Word8
OpBalance ->
case [Expr 'EWord]
stk of
Expr 'EWord
x':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x' [Char]
"BALANCE" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
x ->
Addr -> EVM () -> EVM ()
accessAndBurn (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
x) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
x) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
c -> do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Contract
c.balance)
[] ->
EVM ()
underrun
GenericOp Word8
OpOrigin ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num VM
vm.tx.origin)
GenericOp Word8
OpCaller ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym VM
vm.state.caller
GenericOp Word8
OpCallvalue ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym VM
vm.state.callvalue
GenericOp Word8
OpCalldataload -> (?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\Expr 'EWord
ind -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
Expr.readWord Expr 'EWord
ind VM
vm.state.calldata
GenericOp Word8
OpCalldatasize ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xTo, W256
xSize) ->
Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_copy forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xSize) Word64
32) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xTo W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory VM
vm.state.calldata Expr 'EWord
xSize' Expr 'EWord
xFrom Expr 'EWord
xTo'
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpCodesize ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
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" forall (a :: OpticKind) 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'' forall (a :: OpticKind). Ord a => a -> a -> Bool
<= ( (forall (a :: OpticKind). Bounded a => a
maxBound :: Word64) forall (a :: OpticKind). Num a => a -> a -> a
- Word64
g_verylow ) forall (a :: OpticKind). Integral a => a -> a -> a
`div` Word64
g_copy forall (a :: OpticKind). Num a => a -> a -> a
* Word64
32 then
Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_copy forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
n) Word64
32) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
memOffset W256
n forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#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 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm.tx.gasprice
GenericOp Word8
OpExtcodesize ->
case [Expr 'EWord]
stk of
Expr 'EWord
x':[Expr 'EWord]
xs -> case Expr 'EWord
x' of
Lit W256
x -> if W256
x forall (a :: OpticKind). Eq a => a -> a -> Bool
== forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
cheatCode
then do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
Expr 'EWord -> EVM ()
pushSym (W256 -> Expr 'EWord
Lit W256
1)
else
Addr -> EVM () -> EVM ()
accessAndBurn (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
x) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
x) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
c -> do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
Expr 'EWord -> EVM ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Expr 'Buf)
bytecode Contract
c))
Expr 'EWord
_ -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
Expr 'EWord -> EVM ()
pushSym (Expr 'EWord -> Expr 'EWord
CodeSize Expr 'EWord
x')
(?op::Word8) => EVM ()
next
[] ->
EVM ()
underrun
GenericOp Word8
OpExtcodecopy ->
case [Expr 'EWord]
stk of
Expr 'EWord
extAccount':Expr 'EWord
memOffset':Expr 'EWord
codeOffset:Expr 'EWord
codeSize':[Expr 'EWord]
xs ->
(Expr 'EWord, Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256, W256) -> EVM ()) -> EVM ()
forceConcrete3 (Expr 'EWord
extAccount', Expr 'EWord
memOffset', Expr 'EWord
codeSize') [Char]
"EXTCODECOPY" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
extAccount, W256
memOffset, W256
codeSize) -> do
Bool
acc <- Addr -> EVM Bool
accessAccountForGas (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
extAccount)
let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
Word64 -> EVM () -> EVM ()
burn (Word64
cost forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_copy forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
codeSize) Word64
32) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
memOffset W256
codeSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
extAccount) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
c -> do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
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 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xTo, W256
xSize) ->
Word64 -> EVM () -> EVM ()
burn (Word64
g_verylow forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_copy forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xSize) Word64
32) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xTo W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256
l forall (a :: OpticKind). Ord a => a -> a -> Bool
< W256
f forall (a :: OpticKind). Num a => a -> a -> a
+ W256
xSize Bool -> Bool -> Bool
|| W256
f forall (a :: OpticKind). Num a => a -> a -> a
+ W256
xSize forall (a :: OpticKind). 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
x ->
Addr -> EVM () -> EVM ()
accessAndBurn (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
x) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
x) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
c ->
if Contract -> Bool
accountEmpty Contract
c
then W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (Int
0 :: Int))
else Expr 'EWord -> EVM ()
pushSym forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
keccak (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(a :: OpticKind).
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
(?op::Word8) => Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM ()
stackOp1 Word64
g_blockhash forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \case
Lit W256
i -> if W256
i forall (a :: OpticKind). Num a => a -> a -> a
+ W256
256 forall (a :: OpticKind). Ord a => a -> a -> Bool
< VM
vm.block.number Bool -> Bool -> Bool
|| W256
i forall (a :: OpticKind). Ord a => a -> a -> Bool
>= VM
vm.block.number
then W256 -> Expr 'EWord
Lit W256
0
else (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
i :: Integer) forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). Show a => a -> [Char]
show forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& [Char] -> ByteString
Char8.pack forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& ByteString -> W256
keccak' forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& W256 -> Expr 'EWord
Lit
Expr 'EWord
i -> Expr 'EWord -> Expr 'EWord
BlockHash Expr 'EWord
i
GenericOp Word8
OpCoinbase ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num VM
vm.block.coinbase)
GenericOp Word8
OpTimestamp ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> Expr 'EWord -> EVM ()
pushSym VM
vm.block.timestamp
GenericOp Word8
OpNumber ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm.block.number
GenericOp Word8
OpPrevRandao -> do
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm.block.prevRandao
GenericOp Word8
OpGaslimit ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num VM
vm.block.gaslimit)
GenericOp Word8
OpChainid ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm.env.chainId
GenericOp Word8
OpSelfbalance ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_low forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push Contract
this.balance
GenericOp Word8
OpBaseFee ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push VM
vm.block.baseFee
GenericOp Word8
OpPop ->
case [Expr 'EWord]
stk of
Expr 'EWord
_:[Expr 'EWord]
xs -> Word64 -> EVM () -> EVM ()
burn Word64
g_base ((?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
x ->
Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> EVM () -> EVM ()
accessMemoryWord W256
x forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
x) Expr 'Buf
mem forall (a :: OpticKind). 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
x ->
Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> EVM () -> EVM ()
accessMemoryWord W256
x forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory) (Expr 'EWord -> Expr 'EWord -> Expr 'Buf -> Expr 'Buf
writeWord (W256 -> Expr 'EWord
Lit W256
x) Expr 'EWord
y Expr 'Buf
mem)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
x ->
Word64 -> EVM () -> EVM ()
burn Word64
g_verylow forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
x W256
1 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
let yByte :: Expr 'Byte
yByte = Expr 'EWord -> Expr 'EWord -> Expr 'Byte
indexWord (W256 -> Expr 'EWord
Lit W256
31) Expr 'EWord
y
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory) (Expr 'EWord -> Expr 'Byte -> Expr 'Buf -> Expr 'Buf
writeByte (W256 -> Expr 'EWord
Lit W256
x) Expr 'Byte
yByte)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpSload ->
case [Expr 'EWord]
stk of
Expr 'EWord
x:[Expr 'EWord]
xs -> do
Bool
acc <- Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
self Expr 'EWord
x
let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_sload
Word64 -> EVM () -> EVM ()
burn Word64
cost forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
self Expr 'EWord
x forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Expr 'EWord
y -> do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (Expr 'EWord
yforall (a :: OpticKind). a -> [a] -> [a]
:[Expr 'EWord]
xs)
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpSstore ->
EVM () -> EVM ()
notStatic forall (a :: OpticKind) b. (a -> b) -> a -> b
$
case [Expr 'EWord]
stk of
Expr 'EWord
x:Expr 'EWord
new:[Expr 'EWord]
xs ->
Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
self Expr 'EWord
x forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Expr 'EWord
current -> do
Word64
availableGas <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#gas)
if forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
availableGas forall (a :: OpticKind). Ord a => a -> a -> Bool
<= Word64
g_callstipend then
FrameResult -> EVM ()
finishFrame (EvmError -> FrameResult
FrameErrored (Word64 -> Word64 -> EvmError
OutOfGas Word64
availableGas (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
g_callstipend)))
else do
let
original :: W256
original =
case Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'EWord
x (Map W256 (Map W256 W256) -> Expr 'Storage
ConcreteStore VM
vm.env.origStorage) of
Just (Lit W256
v) -> W256
v
Maybe (Expr 'EWord)
_ -> W256
0
storage_cost :: Word64
storage_cost =
case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
current, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
new) of
(Just W256
current', Just W256
new') ->
if (W256
current' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
new') then Word64
g_sload
else if (W256
current' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
original) Bool -> Bool -> Bool
&& (W256
original forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0) then Word64
g_sset
else if (W256
current' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
original) then Word64
g_sreset
else Word64
g_sload
(Maybe W256, Maybe W256)
_ -> Word64
g_sset
Bool
acc <- Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
self Expr 'EWord
x
let cold_storage_cost :: Word64
cold_storage_cost = if Bool
acc then Word64
0 else Word64
g_cold_sload
Word64 -> EVM () -> EVM ()
burn (Word64
storage_cost forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
cold_storage_cost) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "storage" a => a
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
self) Expr 'EWord
x Expr 'EWord
new)
case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
current, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
new) of
(Just W256
current', Just W256
new') ->
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
unless (W256
current' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
new') forall (a :: OpticKind) b. (a -> b) -> a -> b
$
if W256
current' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
original then
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (W256
original forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0 Bool -> Bool -> Bool
&& W256
new' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Word64 -> EVM ()
refund (Word64
g_sreset forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
else do
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (W256
original forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
if W256
current' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0
then Word64 -> EVM ()
unRefund (Word64
g_sreset forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
else forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (W256
new' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Word64 -> EVM ()
refund (Word64
g_sreset forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (W256
original forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
new') forall (a :: OpticKind) b. (a -> b) -> a -> b
$
if W256
original forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0
then Word64 -> EVM ()
refund (Word64
g_sset forall (a :: OpticKind). Num a => a -> a -> a
- Word64
g_sload)
else Word64 -> EVM ()
refund (Word64
g_sreset forall (a :: OpticKind). Num a => a -> a -> a
- Word64
g_sload)
(Maybe W256, Maybe W256)
_ -> forall (m :: OpticKind -> OpticKind). Monad m => m ()
noop
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpJump ->
case [Expr 'EWord]
stk of
Expr 'EWord
x:[Expr 'EWord]
xs ->
Word64 -> EVM () -> EVM ()
burn Word64
g_mid forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'EWord -> [Char] -> (W256 -> EVM ()) -> EVM ()
forceConcrete Expr 'EWord
x [Char]
"JUMP: symbolic jumpdest" forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
x' ->
Word64 -> EVM () -> EVM ()
burn Word64
g_high forall (a :: OpticKind) b. (a -> b) -> a -> b
$
let jump :: Bool -> EVM ()
jump :: Bool -> EVM ()
jump Bool
False = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> (?op::Word8) => EVM ()
next
jump Bool
_ = case W256 -> Maybe Int
toInt W256
x' of
Maybe Int
Nothing -> 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 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num VM
vm.state.pc)
GenericOp Word8
OpMsize ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num VM
vm.state.memorySize)
GenericOp Word8
OpGas ->
Int -> EVM () -> EVM ()
limitStack Int
1 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM () -> EVM ()
burn Word64
g_base forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) => EVM ()
next forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (VM
vm.state.gas forall (a :: OpticKind). Num a => a -> a -> a
- Word64
g_base))
GenericOp Word8
OpJumpdest -> Word64 -> EVM () -> EVM ()
burn Word64
g_jumpdest (?op::Word8) => EVM ()
next
GenericOp Word8
OpExp ->
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
exponent ->
let cost :: Word64
cost = if W256
exponent forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0
then Word64
g_exp
else Word64
g_exp forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_expbyte forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (Int
1 forall (a :: OpticKind). Num a => a -> a -> a
+ forall (b :: OpticKind). FiniteBits b => b -> Int
log2 W256
exponent) Int
8)
in Word64 -> EVM () -> EVM ()
burn Word64
cost forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
(forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(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' forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpSignextend -> (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
g_low (forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> (a, b) -> c
uncurry Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sex)
GenericOp Word8
OpCreate ->
EVM () -> EVM ()
notStatic forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xValue, W256
xOffset, W256
xSize) -> do
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Word64
availableGas <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#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 forall (a :: OpticKind) 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 ()
create Addr
self Contract
this W256
xSize (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
gas') W256
xValue [Expr 'EWord]
xs Addr
newAddr Expr 'Buf
initCode
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpCall ->
case [Expr 'EWord]
stk of
Expr 'EWord
xGas':Expr 'EWord
xTo:Expr 'EWord
xValue':Expr 'EWord
xInOffset':Expr 'EWord
xInSize':Expr 'EWord
xOutOffset':Expr 'EWord
xOutSize':[Expr 'EWord]
xs ->
(Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord, Expr 'EWord,
Expr 'EWord)
-> [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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xGas, W256
xValue, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
(if W256
xValue forall (a :: OpticKind). Ord a => a -> a -> Bool
> W256
0 then EVM () -> EVM ()
notStatic else forall (a :: OpticKind). a -> a
id) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xGas) Expr 'EWord
xTo Expr 'EWord
xTo W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Addr
callee -> do
let from' :: Addr
from' = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Addr
self VM
vm.overrideCaller
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (a :: OpticKind). IsLabel "state" a => a
#state forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "callvalue" a => a
#callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "caller" a => a
#caller (Addr -> Expr 'EWord
litAddr Addr
from')
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "contract" a => a
#contract Addr
callee
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "overrideCaller" a => a
#overrideCaller forall (a :: OpticKind). 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xGas, W256
xValue, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
(?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xGas) Expr 'EWord
xTo (Addr -> Expr 'EWord
litAddr Addr
self) W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Addr
_ -> do
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (a :: OpticKind). IsLabel "state" a => a
#state forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "callvalue" a => a
#callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "caller" a => a
#caller forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> Expr 'EWord
litAddr forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Addr
self VM
vm.overrideCaller
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "overrideCaller" a => a
#overrideCaller forall (a :: OpticKind). 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) ->
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
let
output :: Expr 'Buf
output = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
xOffset' Expr 'EWord
xSize' VM
vm
codesize :: W256
codesize = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"RETURN: cannot return dynamically sized abstract data")
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> Maybe W256
maybeLitWord forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> Expr 'EWord
bufLength forall (a :: OpticKind) 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 forall (a :: OpticKind). 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 forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
codesize) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
FrameResult -> EVM ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
frameErrored :: EVM ()
frameErrored = FrameResult -> EVM ()
finishFrame forall (a :: OpticKind) 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)) forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xGas, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) ->
(?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xGas) Expr 'EWord
xTo (Addr -> Expr 'EWord
litAddr Addr
self) W256
0 W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Addr
_ -> do
Addr -> EVM ()
touchAccount Addr
self
[Expr 'EWord]
_ -> EVM ()
underrun
GenericOp Word8
OpCreate2 -> EVM () -> EVM ()
notStatic forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xValue, W256
xOffset, W256
xSize, W256
xSalt) ->
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Word64
availableGas <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#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" forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(?op::Word8) =>
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\(W256
xGas, W256
xInOffset, W256
xInSize, W256
xOutOffset, W256
xOutSize) -> do
(?op::Word8) =>
Contract
-> Word64
-> Expr 'EWord
-> Expr 'EWord
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Addr -> EVM ())
-> EVM ()
delegateCall Contract
this (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
xGas) Expr 'EWord
xTo Expr 'EWord
xTo W256
0 W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Addr
callee -> do
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (a :: OpticKind). IsLabel "state" a => a
#state forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "callvalue" a => a
#callvalue (W256 -> Expr 'EWord
Lit W256
0)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "caller" a => a
#caller forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> Expr 'EWord
litAddr forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Addr
self (VM
vm.overrideCaller)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "contract" a => a
#contract Addr
callee
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "static" a => a
#static Bool
True
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "overrideCaller" a => a
#overrideCaller forall (a :: OpticKind). Maybe a
Nothing
Addr -> EVM ()
touchAccount Addr
self
Addr -> EVM ()
touchAccount Addr
callee
[Expr 'EWord]
_ ->
EVM ()
underrun
GenericOp Word8
OpSelfdestruct ->
EVM () -> EVM ()
notStatic forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num -> Addr
xTo) -> do
Bool
acc <- Addr -> EVM Bool
accessAccountForGas (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
xTo)
let cost :: Word64
cost = if Bool
acc then Word64
0 else Word64
g_cold_account_access
funds :: W256
funds = Contract
this.balance
recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xTo VM
vm
c_new :: Word64
c_new = if Bool -> Bool
not Bool
recipientExists Bool -> Bool -> Bool
&& W256
funds forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0
then Word64
g_selfdestruct_newaccount
else Word64
0
Word64 -> EVM () -> EVM ()
burn (Word64
g_selfdestruct forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
c_new forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
cost) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Addr -> EVM ()
selfdestruct Addr
self
Addr -> EVM ()
touchAccount Addr
xTo
if W256
funds forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0
then Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
xTo forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(W256
xOffset, W256
xSize) ->
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOffset W256
xSize forall (a :: OpticKind) 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 forall (a :: OpticKind) 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 = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
transfer Addr
xFrom Addr
xTo W256
xValue = do
Maybe W256
sb <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
xFrom forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "balance" a => a
#balance
case Maybe W256
sb of
Just W256
srcBal ->
if W256
xValue forall (a :: OpticKind). Ord a => a -> a -> Bool
> W256
srcBal
then EvmError -> EVM ()
vmError forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
BalanceTooLow W256
xValue W256
srcBal
else do
(forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
xFrom forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "balance" a => a
#balance) forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (forall (a :: OpticKind). Num a => a -> a -> a
subtract W256
xValue)
(forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
xTo forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "balance" a => a
#balance) forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (forall (a :: OpticKind). Num a => a -> a -> a
+ W256
xValue)
Maybe W256
Nothing -> EvmError -> EVM ()
vmError forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
BalanceTooLow W256
xValue W256
0
callChecks
:: (?op :: Word8)
=> Contract -> Word64 -> Addr -> Addr -> W256 -> W256 -> W256 -> W256 -> W256 -> [Expr EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks :: (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
xGas Addr
xContext Addr
xTo W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs Word64 -> EVM ()
continue = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let fees :: FeeSchedule Word64
fees = VM
vm.block.schedule
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xInOffset W256
xInSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
xOutOffset W256
xOutSize forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Word64
availableGas <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#gas)
let recipientExists :: Bool
recipientExists = Addr -> VM -> Bool
accountExists Addr
xContext VM
vm
(Word64
cost, Word64
gas') <- FeeSchedule Word64
-> Bool -> W256 -> Word64 -> Word64 -> Addr -> EVM (Word64, Word64)
costOfCall FeeSchedule Word64
fees Bool
recipientExists W256
xValue Word64
availableGas Word64
xGas Addr
xTo
Word64 -> EVM () -> EVM ()
burn (Word64
cost forall (a :: OpticKind). Num a => a -> a -> a
- Word64
gas') forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
if W256
xValue forall (a :: OpticKind). Ord a => a -> a -> Bool
> forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Contract
this.balance
then do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
TraceData -> EVM ()
pushTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace (W256 -> W256 -> EvmError
BalanceTooLow W256
xValue Contract
this.balance)
(?op::Word8) => EVM ()
next
else if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length VM
vm.frames forall (a :: OpticKind). Ord a => a -> a -> Bool
>= Int
1024
then do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
TraceData -> EVM ()
pushTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
CallDepthLimitReached
(?op::Word8) => EVM ()
next
else Word64 -> EVM ()
continue Word64
gas'
precompiledContract
:: (?op :: Word8)
=> Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256 -> W256 -> W256 -> W256
-> [Expr EWord]
-> EVM ()
precompiledContract :: (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
precompiledContract Contract
this Word64
xGas Addr
precompileAddr Addr
recipient W256
xValue W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs =
(?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
xGas Addr
recipient Addr
precompileAddr W256
xValue W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Word64
gas' ->
do
(?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
precompileAddr Word64
gas' W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs
Addr
self <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contract" a => a
#contract)
[Expr 'EWord]
stk <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack)
Int
pc' <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "pc" a => a
#pc)
Maybe VMResult
result' <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (a :: OpticKind). IsLabel "result" a => a
#result
case Maybe VMResult
result' of
Maybe VMResult
Nothing -> case [Expr 'EWord]
stk of
Expr 'EWord
x:[Expr 'EWord]
_ -> case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
x of
Just W256
0 ->
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
Just W256
1 ->
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
recipient forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc' [Char]
"unexpected return value from precompile" (forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
x])
[Expr 'EWord]
_ -> EVM ()
underrun
Maybe VMResult
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
executePrecompile
:: (?op :: Word8)
=> Addr
-> Word64 -> W256 -> W256 -> W256 -> W256 -> [Expr EWord]
-> EVM ()
executePrecompile :: (?op::Word8) =>
Addr
-> Word64
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
executePrecompile Addr
preCompileAddr Word64
gasCap W256
inOffset W256
inSize W256
outOffset W256
outSize [Expr 'EWord]
xs = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let input :: Expr 'Buf
input = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit W256
inOffset) (W256 -> Expr 'EWord
Lit W256
inSize) VM
vm
fees :: FeeSchedule Word64
fees = VM
vm.block.schedule
cost :: Word64
cost = FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile FeeSchedule Word64
fees Addr
preCompileAddr Expr 'Buf
input
notImplemented :: EVM ()
notImplemented = forall a. HasCallStack => [Char] -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Char]
"precompile at address " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> [Char]
show Addr
preCompileAddr forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Char]
" not yet implemented"
precompileFail :: EVM ()
precompileFail = Word64 -> EVM () -> EVM ()
burn (Word64
gasCap forall (a :: OpticKind). Num a => a -> a -> a
- Word64
cost) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
TraceData -> EVM ()
pushTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
PrecompileFailure
(?op::Word8) => EVM ()
next
if Word64
cost forall (a :: OpticKind). Ord a => a -> a -> Bool
> Word64
gasCap then
Word64 -> EVM () -> EVM ()
burn Word64
gasCap forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
(?op::Word8) => EVM ()
next
else Word64 -> EVM () -> EVM ()
burn Word64
cost forall (a :: OpticKind) b. (a -> b) -> a -> b
$
case Addr
preCompileAddr of
Addr
0x1 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECRECOVER" forall (a :: OpticKind) 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
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
(?op::Word8) => EVM ()
next
Just ByteString
output -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output)
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output) (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x2 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"SHA2-256" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \ByteString
input' -> do
let
hash :: Expr 'Buf
hash = forall {ba :: OpticKind}. ByteArrayAccess ba => ba -> Expr 'Buf
sha256Buf ByteString
input'
sha256Buf :: ba -> Expr 'Buf
sha256Buf ba
x = ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (bin :: OpticKind) (bout :: OpticKind).
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall (ba :: OpticKind) (a :: OpticKind).
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ba
x :: Digest SHA256)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
hash
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
hash (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x3 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"RIPEMD160" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \ByteString
input' -> do
let
padding :: ByteString
padding = [Word8] -> ByteString
BS.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Int -> a -> [a]
replicate Int
12 Word8
0
hash' :: ByteString
hash' = forall (bin :: OpticKind) (bout :: OpticKind).
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall (ba :: OpticKind) (a :: OpticKind).
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
input' :: Digest RIPEMD160)
hash :: Expr 'Buf
hash = ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString
padding forall (a :: OpticKind). Semigroup a => a -> a -> a
<> ByteString
hash'
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
hash
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
hash (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x4 -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
input
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
input (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x5 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"MODEXP" forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
if W256 -> W256 -> ByteString -> Bool
isZero (W256
96 forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lenb forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
then Int -> ByteString -> ByteString
truncpadlit (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
lenm) (forall (a :: OpticKind). Integral a => a -> ByteString
asBE (Int
0 :: Int))
else
let
b :: Integer
b = ByteString -> Integer
asInteger forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
96 W256
lenb ByteString
input'
e :: Integer
e = ByteString -> Integer
asInteger forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input'
m :: Integer
m = ByteString -> Integer
asInteger forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lenb forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
in
Int -> ByteString -> ByteString
padLeft (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
lenm) (forall (a :: OpticKind). Integral a => a -> ByteString
asBE (Integer -> Integer -> Integer -> Integer
expFast Integer
b Integer
e Integer
m))
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
output
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
output (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x6 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECADD" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \ByteString
input' ->
case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x6 (Int -> ByteString -> ByteString
truncpadlit Int
128 ByteString
input') Int
64 of
Maybe ByteString
Nothing -> EVM ()
precompileFail
Just ByteString
output -> do
let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
truncpaddedOutput
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x7 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECMUL" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \ByteString
input' ->
case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x7 (Int -> ByteString -> ByteString
truncpadlit Int
96 ByteString
input') Int
64 of
Maybe ByteString
Nothing -> EVM ()
precompileFail
Just ByteString
output -> do
let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
truncpaddedOutput
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x8 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECPAIR" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \ByteString
input' ->
case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x8 ByteString
input' Int
32 of
Maybe ByteString
Nothing -> EVM ()
precompileFail
Just ByteString
output -> do
let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
32 ByteString
output
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
truncpaddedOutput
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Addr
0x9 ->
Expr 'Buf -> [Char] -> (ByteString -> EVM ()) -> EVM ()
forceConcreteBuf Expr 'Buf
input [Char]
"BLAKE2" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \ByteString
input' -> do
case (ByteString -> Int
BS.length ByteString
input', Word8
1 forall (a :: OpticKind). Ord a => a -> a -> Bool
>= HasCallStack => ByteString -> Word8
BS.last ByteString
input') of
(Int
213, Bool
True) -> case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x9 ByteString
input' Int
64 of
Just ByteString
output -> do
let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
1 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
truncpaddedOutput
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput (W256 -> Expr 'EWord
Lit W256
outSize) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
outOffset)
(?op::Word8) => EVM ()
next
Maybe ByteString
Nothing -> EVM ()
precompileFail
(Int, Bool)
_ -> EVM ()
precompileFail
Addr
_ -> EVM ()
notImplemented
truncpadlit :: Int -> ByteString -> ByteString
truncpadlit :: Int -> ByteString -> ByteString
truncpadlit Int
n ByteString
xs = if Int
m forall (a :: OpticKind). Ord a => a -> a -> Bool
> Int
n then Int -> ByteString -> ByteString
BS.take Int
n ByteString
xs
else ByteString -> ByteString -> ByteString
BS.append ByteString
xs (Int -> Word8 -> ByteString
BS.replicate (Int
n forall (a :: OpticKind). Num a => a -> a -> a
- Int
m) Word8
0)
where m :: Int
m = ByteString -> Int
BS.length ByteString
xs
lazySlice :: W256 -> W256 -> ByteString -> LS.ByteString
lazySlice :: W256 -> W256 -> ByteString -> ByteString
lazySlice W256
offset W256
size ByteString
bs =
let bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LS.take (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
size) (Int64 -> ByteString -> ByteString
LS.drop (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
offset) (ByteString -> ByteString
fromStrict ByteString
bs))
in ByteString
bs' forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Int64 -> Word8 -> ByteString
LS.replicate ((forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
size) forall (a :: OpticKind). Num a => a -> a -> a
- ByteString -> Int64
LS.length ByteString
bs') Word8
0
parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input =
let lenb :: W256
lenb = ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
0 W256
32 ByteString
input
lene :: W256
lene = ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
32 W256
64 ByteString
input
lenm :: W256
lenm = ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
64 W256
96 ByteString
input
in (W256
lenb, W256
lene, W256
lenm)
isZero :: W256 -> W256 -> ByteString -> Bool
isZero :: W256 -> W256 -> ByteString -> Bool
isZero W256
offset W256
size ByteString
bs =
(Word8 -> Bool) -> ByteString -> Bool
LS.all (forall (a :: OpticKind). Eq a => a -> a -> Bool
== Word8
0) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Int64 -> ByteString -> ByteString
LS.take (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
size) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Int64 -> ByteString -> ByteString
LS.drop (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
offset) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
ByteString -> ByteString
fromStrict ByteString
bs
asInteger :: LS.ByteString -> Integer
asInteger :: ByteString -> Integer
asInteger ByteString
xs = if ByteString
xs forall (a :: OpticKind). Eq a => a -> a -> Bool
== forall (a :: OpticKind). Monoid a => a
mempty then Integer
0
else Integer
256 forall (a :: OpticKind). Num a => a -> a -> a
* ByteString -> Integer
asInteger (HasCallStack => ByteString -> ByteString
LS.init ByteString
xs)
forall (a :: OpticKind). Num a => a -> a -> a
+ forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (HasCallStack => ByteString -> Word8
LS.last ByteString
xs)
noop :: Monad m => m ()
noop :: forall (m :: OpticKind -> OpticKind). Monad m => m ()
noop = forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()
pushTo :: MonadState s m => Lens s s [a] [a] -> a -> m ()
pushTo :: forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
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 forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(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 :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
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 forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (forall (a :: OpticKind). 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 = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Effect -> VMResult
HandleEffect forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Query -> Effect
Query
choose :: Choose -> EVM ()
choose :: Choose -> EVM ()
choose = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Effect -> VMResult
HandleEffect forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(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 <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (a :: OpticKind). IsLabel "constraints" a => a
#constraints
Query -> EVM ()
query forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'EWord -> [Prop] -> (BranchCondition -> EVM ()) -> Query
PleaseAskSMT Expr 'EWord
cond [Prop]
pathconds BranchCondition -> EVM ()
choosePath
where
choosePath :: BranchCondition -> EVM ()
choosePath (Case Bool
v) = do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (a :: OpticKind). Maybe a
Nothing
forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo forall (a :: OpticKind). IsLabel "constraints" a => a
#constraints forall (a :: OpticKind) b. (a -> b) -> a -> b
$ if Bool
v then (Expr 'EWord
cond forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
./= W256 -> Expr 'EWord
Lit W256
0) else (Expr 'EWord
cond forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== W256 -> Expr 'EWord
Lit W256
0)
(Int
iteration, [Expr 'EWord]
_) <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "iterations" a => a
#iterations forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
loc forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). Eq a => a -> Iso' (Maybe a) a
non (Int
0,[]))
[Expr 'EWord]
stack <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "path" a => a
#path forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (CodeLocation
loc, Int
iteration)) (forall (a :: OpticKind). a -> Maybe a
Just Bool
v)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "iterations" a => a
#iterations forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
loc) (forall (a :: OpticKind). a -> Maybe a
Just (Int
iteration forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, [Expr 'EWord]
stack))
Bool -> EVM ()
continue Bool
v
choosePath BranchCondition
Unknown =
Choose -> EVM ()
choose forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> (Bool -> EVM ()) -> Choose
PleaseChoosePath Expr 'EWord
cond forall (a :: OpticKind) b. (a -> b) -> a -> b
$ BranchCondition -> EVM ()
choosePath forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Bool -> BranchCondition
Case
fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr Contract -> EVM ()
continue =
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Just Contract
c -> Contract -> EVM ()
continue Contract
c
Maybe Contract
Nothing ->
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "fetchedContracts" a => a
#fetchedContracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Just Contract
c -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall (a :: OpticKind). a -> Maybe a
Just Contract
c)
Contract -> EVM ()
continue Contract
c
Maybe Contract
Nothing -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "result" a => a
#result) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Effect -> VMResult
HandleEffect forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Query -> Effect
Query forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Addr -> (Contract -> EVM ()) -> Query
PleaseFetchContract Addr
addr
(\Contract
c -> do forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "fetchedContracts" a => a
#fetchedContracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall (a :: OpticKind). a -> Maybe a
Just Contract
c)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall (a :: OpticKind). a -> Maybe a
Just Contract
c)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (a :: OpticKind). 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) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
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
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
litSlot -> do
Map W256 (Map W256 W256)
cachedStore <- (.cache.fetchedStorage) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
case forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
addr) Map W256 (Map W256 W256)
cachedStore forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup W256
litSlot of
Maybe W256
Nothing -> W256 -> EVM ()
mkQuery W256
litSlot
Just W256
val -> Expr 'EWord -> EVM ()
continue (W256 -> Expr 'EWord
Lit W256
val)
else do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "storage" a => a
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
0))
Expr 'EWord -> EVM ()
continue forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord
Lit W256
0
Maybe (IxValue (Map Addr Contract))
Nothing ->
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
addr forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Addr -> W256 -> (W256 -> EVM ()) -> Query
PleaseFetchSlot Addr
addr W256
s
(\W256
x -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "fetchedStorage" a => a
#fetchedStorage forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
addr)) (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert W256
s W256
x)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "storage" a => a
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
x))
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (a :: OpticKind). Maybe a
Nothing
Expr 'EWord -> EVM ()
continue (W256 -> Expr 'EWord
Lit W256
x))
accountExists :: Addr -> VM -> Bool
accountExists :: Addr -> VM -> Bool
accountExists Addr
addr VM
vm =
case forall (k :: OpticKind) (a :: OpticKind).
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
accountEmpty :: Contract -> Bool
accountEmpty :: Contract -> Bool
accountEmpty Contract
c =
case Contract
c.contractcode of
RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
True
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
b) -> forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Bool
null Vector (Expr 'Byte)
b
ContractCode
_ -> Bool
False
Bool -> Bool -> Bool
&& Contract
c.nonce forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0
Bool -> Bool -> Bool
&& Contract
c.balance forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0
finalize :: EVM ()
finalize :: EVM ()
finalize = do
let
revertContracts :: m ()
revertContracts = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "txReversion" a => a
#txReversion) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts)
revertSubstate :: m ()
revertSubstate = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate) ([Addr]
-> [Addr]
-> Set Addr
-> Set (Addr, W256)
-> [(Addr, Word64)]
-> SubState
SubState forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (a :: OpticKind). IsLabel "result" a => a
#result forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Just (VMFailure (Revert Expr 'Buf
_)) -> do
forall {k :: OpticKind} {l :: OpticKind} {k :: OpticKind}
{k :: OpticKind} {l :: OpticKind} {k :: OpticKind}
{m :: OpticKind -> OpticKind} {s :: OpticKind} {u :: OpticKind}
{v :: OpticKind} {u :: OpticKind} {v :: OpticKind} {a :: OpticKind}
{a :: OpticKind}.
(JoinKinds k l k, JoinKinds k l k, Is k A_Getter, Is k A_Setter,
MonadState s m, LabelOptic "env" k s s u v,
LabelOptic "tx" k s s u v, LabelOptic "txReversion" l u v a a,
LabelOptic "contracts" l u v a a) =>
m ()
revertContracts
forall {k :: OpticKind} {l :: OpticKind} {k :: OpticKind}
{s :: OpticKind} {m :: OpticKind -> OpticKind} {u :: OpticKind}
{v :: OpticKind} {a :: OpticKind}.
(JoinKinds k l k, MonadState s m, Is k A_Setter,
LabelOptic "tx" k s s u v,
LabelOptic "substate" l u v a SubState) =>
m ()
revertSubstate
Just (VMFailure EvmError
_) -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#gas) Word64
0
forall {k :: OpticKind} {l :: OpticKind} {k :: OpticKind}
{k :: OpticKind} {l :: OpticKind} {k :: OpticKind}
{m :: OpticKind -> OpticKind} {s :: OpticKind} {u :: OpticKind}
{v :: OpticKind} {u :: OpticKind} {v :: OpticKind} {a :: OpticKind}
{a :: OpticKind}.
(JoinKinds k l k, JoinKinds k l k, Is k A_Getter, Is k A_Setter,
MonadState s m, LabelOptic "env" k s s u v,
LabelOptic "tx" k s s u v, LabelOptic "txReversion" l u v a a,
LabelOptic "contracts" l u v a a) =>
m ()
revertContracts
forall {k :: OpticKind} {l :: OpticKind} {k :: OpticKind}
{s :: OpticKind} {m :: OpticKind -> OpticKind} {u :: OpticKind}
{v :: OpticKind} {a :: OpticKind}.
(JoinKinds k l k, MonadState s m, Is k A_Setter,
LabelOptic "tx" k s s u v,
LabelOptic "substate" l u v a SubState) =>
m ()
revertSubstate
Just (VMSuccess Expr 'Buf
output) -> do
Int
pc' <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "pc" a => a
#pc)
Bool
creation <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "isCreate" a => a
#isCreate)
Addr
createe <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contract" a => a
#contract)
Bool
createeExists <- (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Bool
Map.member Addr
createe) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts)
let onContractCode :: ContractCode -> EVM ()
onContractCode ContractCode
contractCode =
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (Bool
creation Bool -> Bool -> Bool
&& Bool
createeExists) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> ContractCode -> EVM ()
replaceCode Addr
createe ContractCode
contractCode
case Expr 'Buf
output of
ConcreteBuf ByteString
bs ->
ContractCode -> EVM ()
onContractCode forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc' [Char]
"runtime code cannot have an abstract lentgh" (forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
output])
Just Vector (Expr 'Byte)
ops ->
ContractCode -> EVM ()
onContractCode forall (a :: OpticKind) b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
ops)
Maybe VMResult
_ ->
forall a. HasCallStack => [Char] -> a
error [Char]
"Finalising an unfinished tx."
Block
block <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (a :: OpticKind). IsLabel "block" a => a
#block
TxState
tx <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use forall (a :: OpticKind). IsLabel "tx" a => a
#tx
Word64
gasRemaining <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#gas)
let
sumRefunds :: Word64
sumRefunds = forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
(Foldable t, Num a) =>
t a -> a
sum (forall (a :: OpticKind) (b :: OpticKind). (a, b) -> b
snd forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> TxState
tx.substate.refunds)
gasUsed :: Word64
gasUsed = TxState
tx.gaslimit forall (a :: OpticKind). Num a => a -> a -> a
- Word64
gasRemaining
cappedRefund :: Word64
cappedRefund = forall (a :: OpticKind). Ord a => a -> a -> a
min (forall (a :: OpticKind). Integral a => a -> a -> a
quot Word64
gasUsed Word64
5) (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
sumRefunds)
originPay :: W256
originPay = (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Word64
gasRemaining forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
cappedRefund) forall (a :: OpticKind). Num a => a -> a -> a
* TxState
tx.gasprice
minerPay :: W256
minerPay = TxState
tx.priorityFee forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
gasUsed)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts)
(forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
(a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall (a :: OpticKind). IsLabel "balance" a => a
#balance (forall (a :: OpticKind). Num a => a -> a -> a
+ W256
originPay)) TxState
tx.origin)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts)
(forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
(a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall (a :: OpticKind). IsLabel "balance" a => a
#balance (forall (a :: OpticKind). Num a => a -> a -> a
+ W256
minerPay)) Block
block.coinbase)
Addr -> EVM ()
touchAccount Block
block.coinbase
[Addr]
destroyedAddresses <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "selfdestructs" a => a
#selfdestructs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts)
(forall (k :: OpticKind) (a :: OpticKind).
(k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Addr
k Contract
_ -> (Addr
k forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` [Addr]
destroyedAddresses)))
[Addr]
touchedAddresses <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "touchedAccounts" a => a
#touchedAccounts)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts)
(forall (k :: OpticKind) (a :: OpticKind).
(k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
(\Addr
k Contract
a -> Bool -> Bool
not ((Addr
k forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Addr]
touchedAddresses) Bool -> Bool -> Bool
&& Contract -> Bool
accountEmpty Contract
a)))
loadContract :: Addr -> EVM ()
loadContract :: Addr -> EVM ()
loadContract Addr
target =
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
target forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contractcode" a => a
#contractcode) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>=
\case
Maybe ContractCode
Nothing ->
forall a. HasCallStack => [Char] -> a
error [Char]
"Call target doesn't exist"
Just ContractCode
targetCode -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contract" a => a
#contract) Addr
target
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "code" a => a
#code) ContractCode
targetCode
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "codeContract" a => a
#codeContract) Addr
target
limitStack :: Int -> EVM () -> EVM ()
limitStack :: Int -> EVM () -> EVM ()
limitStack Int
n EVM ()
continue = do
[Expr 'EWord]
stk <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack)
if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [Expr 'EWord]
stk forall (a :: OpticKind). Num a => a -> a -> a
+ Int
n forall (a :: OpticKind). 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 <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "static" a => a
#static)
if Bool
bad
then EvmError -> EVM ()
vmError EvmError
StateChangeWhileStatic
else EVM ()
continue
burn :: Word64 -> EVM () -> EVM ()
burn :: Word64 -> EVM () -> EVM ()
burn Word64
n EVM ()
continue = do
Word64
available <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#gas)
if Word64
n forall (a :: OpticKind). 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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
msg (forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
b])
refund :: Word64 -> EVM ()
refund :: Word64 -> EVM ()
refund Word64
n = do
Addr
self <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contract" a => a
#contract)
forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "refunds" a => a
#refunds) (Addr
self, Word64
n)
unRefund :: Word64 -> EVM ()
unRefund :: Word64 -> EVM ()
unRefund Word64
n = do
Addr
self <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contract" a => a
#contract)
[(Addr, Word64)]
refs <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "refunds" a => a
#refunds)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "refunds" a => a
#refunds)
(forall (a :: OpticKind). (a -> Bool) -> [a] -> [a]
filter (\(Addr
a,Word64
b) -> Bool -> Bool
not (Addr
a forall (a :: OpticKind). Eq a => a -> a -> Bool
== Addr
self Bool -> Bool -> Bool
&& Word64
b forall (a :: OpticKind). Eq a => a -> a -> Bool
== Word64
n)) [(Addr, Word64)]
refs)
touchAccount :: Addr -> EVM()
touchAccount :: Addr -> EVM ()
touchAccount = forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo ((forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate) forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "touchedAccounts" a => a
#touchedAccounts)
selfdestruct :: Addr -> EVM()
selfdestruct :: Addr -> EVM ()
selfdestruct = forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo ((forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate) forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "selfdestructs" a => a
#selfdestructs)
accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn :: Addr -> EVM () -> EVM ()
accessAndBurn Addr
x EVM ()
cont = do
FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_initcodeword :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
..} <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "block" a => a
#block forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "schedule" a => a
#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
accessAccountForGas :: Addr -> EVM Bool
accessAccountForGas :: Addr -> EVM Bool
accessAccountForGas Addr
addr = do
Set Addr
accessedAddrs <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "accessedAddresses" a => a
#accessedAddresses)
let accessed :: Bool
accessed = forall (a :: OpticKind). Ord a => a -> Set a -> Bool
member Addr
addr Set Addr
accessedAddrs
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "accessedAddresses" a => a
#accessedAddresses) (forall (a :: OpticKind). Ord a => a -> Set a -> Set a
insert Addr
addr Set Addr
accessedAddrs)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
accessed
accessStorageForGas :: Addr -> Expr EWord -> EVM Bool
accessStorageForGas :: Addr -> Expr 'EWord -> EVM Bool
accessStorageForGas Addr
addr Expr 'EWord
key = do
Set (Addr, W256)
accessedStrkeys <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "accessedStorageKeys" a => a
#accessedStorageKeys)
case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
key of
Just W256
litword -> do
let accessed :: Bool
accessed = forall (a :: OpticKind). Ord a => a -> Set a -> Bool
member (Addr
addr, W256
litword) Set (Addr, W256)
accessedStrkeys
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "accessedStorageKeys" a => a
#accessedStorageKeys) (forall (a :: OpticKind). Ord a => a -> Set a -> Set a
insert (Addr
addr, W256
litword) Set (Addr, W256)
accessedStrkeys)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Bool
accessed
Maybe W256
_ -> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
Monad m =>
a -> m a
return Bool
False
cheatCode :: Addr
cheatCode :: Addr
cheatCode = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (ByteString -> W256
keccak' ByteString
"hevm cheat code")
cheat
:: (?op :: Word8)
=> (W256, W256) -> (W256, W256)
-> EVM ()
cheat :: (?op::Word8) => (W256, W256) -> (W256, W256) -> EVM ()
cheat (W256
inOffset, W256
inSize) (W256
outOffset, W256
outSize) = do
Expr 'Buf
mem <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory)
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let
abi :: Expr 'EWord
abi = Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
inOffset) Expr 'Buf
mem
input :: Expr 'Buf
input = Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory (W256 -> Expr 'EWord
Lit forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256
inOffset forall (a :: OpticKind). Num a => a -> a -> a
+ W256
4) (W256 -> Expr 'EWord
Lit forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256
inSize forall (a :: OpticKind). Num a => a -> a -> a
- W256
4) VM
vm
case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
abi of
Maybe W256
Nothing -> PartialExec -> EVM ()
partial forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM
vm.state.pc [Char]
"symbolic cheatcode selector" (forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
abi])
Just (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral -> FunctionSelector
abi') ->
case forall (k :: OpticKind) (a :: OpticKind).
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
(?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 =
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
[(k, a)] -> Map k a
Map.fromList
[ forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"ffi(string[])" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
outSize Expr 'Buf
input -> do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
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 = forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap
(\case
(AbiString ByteString
a) -> Text -> [Char]
unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
a
AbiValue
_ -> [Char]
"")
(forall (a :: OpticKind). Vector a -> [a]
V.toList Vector AbiValue
strsV)
cont :: ByteString -> EVM ()
cont ByteString
bs = do
let encoded :: Expr 'Buf
encoded = ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
encoded
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory Expr 'Buf
encoded Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (a :: OpticKind). 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 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> EvmError
Revert forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ByteString -> Expr 'Buf
ConcreteBuf forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Text -> AbiValue -> ByteString
abiMethod Text
"Error(string)" (Vector AbiValue -> AbiValue
AbiTuple forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). [a] -> Vector a
V.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [ByteString -> AbiValue
AbiString ByteString
msg]),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"warp(uint256)" forall (a :: OpticKind) 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] -> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "block" a => a
#block forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "timestamp" a => a
#timestamp) Expr 'EWord
x
[Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"roll(uint256)" forall (a :: OpticKind) 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" (forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "block" a => a
#block forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "number" a => a
#number))
[Expr 'EWord]
_ -> EvmError -> EVM ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"store(address,bytes32,bytes32)" forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num -> Addr
a') ->
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
a' forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
_ -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "storage" a => a
#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),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"load(address,bytes32)" forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num -> Addr
a') ->
Addr -> Expr 'EWord -> (Expr 'EWord -> EVM ()) -> EVM ()
accessStorage Addr
a' Expr 'EWord
slot forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Expr 'EWord
res -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
-> Lens (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
res
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
-> Lens (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),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"sign(uint256,bytes32)" forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \(W256
sk', W256
hash') -> do
let (Word8
v,W256
r,W256
s) = W256 -> Integer -> (Word8, W256, W256)
EVM.Sign.sign W256
hash' (forall (a :: OpticKind). Integral a => a -> Integer
toInteger W256
sk')
encoded :: ByteString
encoded = AbiValue -> ByteString
encodeAbiValue forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Vector AbiValue -> AbiValue
AbiTuple (forall (a :: OpticKind). [a] -> Vector a
V.fromList
[ Int -> Word256 -> AbiValue
AbiUInt Int
8 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word8
v
, Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
r)
, Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
s)
])
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded)
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded) (W256 -> Expr 'EWord
Lit forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length forall (a :: OpticKind) 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),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"addr(uint256)" forall (a :: OpticKind) 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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \W256
sk' -> do
let a :: Maybe Addr
a = Integer -> Maybe Addr
EVM.Sign.deriveAddr forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num 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
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
-> Lens (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
expAddr
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
-> Lens (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),
forall {b :: OpticKind}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"prank(address)" forall (a :: OpticKind) 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] -> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "overrideCaller" a => a
#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))
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" forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\((forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num -> Addr
xTo'), (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num -> Addr
xContext')) ->
if Addr
xTo' forall (a :: OpticKind). Ord a => a -> a -> Bool
> Addr
0 Bool -> Bool -> Bool
&& Addr
xTo' forall (a :: OpticKind). Ord a => a -> a -> Bool
<= Addr
9
then (?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> EVM ()
precompiledContract Contract
this Word64
gasGiven Addr
xTo' Addr
xContext' W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs
else if Addr
xTo' forall (a :: OpticKind). Eq a => a -> a -> Bool
== Addr
cheatCode then
do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) [Expr 'EWord]
xs
(?op::Word8) => (W256, W256) -> (W256, W256) -> EVM ()
cheat (W256
xInOffset, W256
xInSize) (W256
xOutOffset, W256
xOutSize)
else
(?op::Word8) =>
Contract
-> Word64
-> Addr
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> [Expr 'EWord]
-> (Word64 -> EVM ())
-> EVM ()
callChecks Contract
this Word64
gasGiven Addr
xContext' Addr
xTo' W256
xValue W256
xInOffset W256
xInSize W256
xOutOffset W256
xOutSize [Expr 'EWord]
xs forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\Word64
xGas -> do
VM
vm0 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
Addr -> (Contract -> EVM ()) -> EVM ()
fetchAccount Addr
xTo' forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Contract
target ->
Word64 -> EVM () -> EVM ()
burn Word64
xGas forall (a :: OpticKind) 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 forall (a :: OpticKind). Ord a => a -> a -> Bool
>= W256
4
then case Expr 'EWord -> Maybe W256
maybeLitWord forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
xInOffset) VM
vm0.state.memory
of Maybe W256
Nothing -> forall (a :: OpticKind). Maybe a
Nothing
Just W256
abi -> forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
abi
else forall (a :: OpticKind). 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)
(?op::Word8) => EVM ()
next
VM
vm1 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo forall (a :: OpticKind). IsLabel "frames" a => a
#frames forall (a :: OpticKind) 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 forall (a :: OpticKind). Monoid a => a
mempty forall (a :: OpticKind). Monoid a => a
mempty
ContractCode
a -> ContractCode
a
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall (a :: OpticKind). IsLabel "state" a => a
#state forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "gas" a => a
#gas (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
xGas)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "pc" a => a
#pc Int
0
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "code" a => a
#code (ContractCode -> ContractCode
clearInitCode Contract
target.contractcode)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "codeContract" a => a
#codeContract Addr
xTo'
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "stack" a => a
#stack forall (a :: OpticKind). Monoid a => a
mempty
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "memory" a => a
#memory forall (a :: OpticKind). Monoid a => a
mempty
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "memorySize" a => a
#memorySize Word64
0
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata forall (a :: OpticKind). Monoid a => a
mempty
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "calldata" a => a
#calldata (Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice (W256 -> Expr 'EWord
Lit W256
xInOffset) (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
xInSize) VM
vm0.state.memory forall (a :: OpticKind). Monoid a => a
mempty)
Addr -> EVM ()
continue Addr
xTo'
collision :: Maybe Contract -> Bool
collision :: Maybe Contract -> Bool
collision Maybe Contract
c' = case Maybe Contract
c' of
Just Contract
c -> Contract
c.nonce forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0 Bool -> Bool -> Bool
|| case Contract
c.contractcode of
RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
False
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
b) -> Bool -> Bool
not forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let xGas :: Word64
xGas = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
xGas'
if Contract
this.nonce forall (a :: OpticKind). Eq a => a -> a -> Bool
== forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (a :: OpticKind). Bounded a => a
maxBound :: Word64)
then do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
TraceData -> EVM ()
pushTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
NonceOverflow
(?op::Word8) => EVM ()
next
else if W256
xValue forall (a :: OpticKind). Ord a => a -> a -> Bool
> Contract
this.balance
then do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
TraceData -> EVM ()
pushTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
BalanceTooLow W256
xValue Contract
this.balance
(?op::Word8) => EVM ()
next
else if W256
xSize forall (a :: OpticKind). Ord a => a -> a -> Bool
> VM
vm0.block.maxCodeSize forall (a :: OpticKind). Num a => a -> a -> a
* W256
2
then do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
EvmError -> EVM ()
vmError forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> EvmError
MaxInitCodeSizeExceeded (VM
vm0.block.maxCodeSize forall (a :: OpticKind). Num a => a -> a -> a
* W256
2) W256
xSize
else if forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length VM
vm0.frames forall (a :: OpticKind). Ord a => a -> a -> Bool
>= Int
1024
then do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
TraceData -> EVM ()
pushTrace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
CallDepthLimitReached
(?op::Word8) => EVM ()
next
else if Maybe Contract -> Bool
collision forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Maybe a
Map.lookup Addr
newAddr VM
vm0.env.contracts
then Word64 -> EVM () -> EVM ()
burn Word64
xGas forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) (W256 -> Expr 'EWord
Lit W256
0 forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
self forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce) forall (a :: OpticKind). Enum a => a -> a
succ
(?op::Word8) => EVM ()
next
else Word64 -> EVM () -> EVM ()
burn Word64
xGas forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Addr -> EVM ()
touchAccount Addr
self
Addr -> EVM ()
touchAccount Addr
newAddr
let
let contract' :: Maybe ContractCode
contract' = do
Integer
prefixLen <- Expr 'Buf -> Maybe Integer
Expr.concPrefix Expr 'Buf
initCode
Vector (Expr 'Byte)
prefix <- Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> Expr 'Buf -> Expr 'Buf
Expr.take (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Integer
prefixLen) Expr 'Buf
initCode
let sym :: Expr 'Buf
sym = W256 -> Expr 'Buf -> Expr 'Buf
Expr.drop (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Integer
prefixLen) Expr 'Buf
initCode
Vector Word8
conc <- forall (t :: OpticKind -> OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind) (b :: OpticKind).
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr 'Byte -> Maybe Word8
maybeLitByte Vector (Expr 'Byte)
prefix
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf -> ContractCode
InitCode ([Word8] -> ByteString
BS.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Vector a -> [a]
V.toList Vector Word8
conc) Expr 'Buf
sym
case Maybe ContractCode
contract' of
Maybe ContractCode
Nothing ->
PartialExec -> EVM ()
partial forall (a :: OpticKind) 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
}
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
Maybe (IxValue (Map Addr Contract))
oldAcc <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
newAddr)
let oldBal :: W256
oldBal = forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe W256
0 (.balance) Maybe (IxValue (Map Addr Contract))
oldAcc
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
newAddr) (forall (a :: OpticKind). a -> Maybe a
Just (Contract
newContract forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (a :: OpticKind). IsLabel "balance" a => a
#balance forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ W256
oldBal))
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
self forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce) forall (a :: OpticKind). Enum a => a -> a
succ
let resetStorage :: Expr 'Storage -> Expr 'Storage
resetStorage = \case
ConcreteStore Map W256 (Map W256 W256)
s -> Map W256 (Map W256 W256) -> Expr 'Storage
ConcreteStore (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Map k a
Map.delete (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
newAddr) Map W256 (Map W256 W256)
s)
Expr 'Storage
AbstractStore -> Expr 'Storage
AbstractStore
Expr 'Storage
EmptyStore -> Expr 'Storage
EmptyStore
SStore {} -> forall a. HasCallStack => [Char] -> a
error [Char]
"trying to reset symbolic storage with writes in create"
GVar GVar 'Storage
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected global variable"
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "storage" a => a
#storage) Expr 'Storage -> Expr 'Storage
resetStorage
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "origStorage" a => a
#origStorage) (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> Map k a -> Map k a
Map.delete (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
newAddr))
Addr -> Addr -> W256 -> EVM ()
transfer Addr
self Addr
newAddr W256
xValue
TraceData -> EVM ()
pushTrace (FrameContext -> TraceData
FrameTrace FrameContext
newContext)
(?op::Word8) => EVM ()
next
VM
vm1 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo forall (a :: OpticKind). IsLabel "frames" a => a
#frames forall (a :: OpticKind) 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 }
}
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "state" a => a
#state forall (a :: OpticKind) b. (a -> b) -> a -> b
$
FrameState
blankState
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "contract" a => a
#contract Addr
newAddr
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "codeContract" a => a
#codeContract Addr
newAddr
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "code" a => a
#code ContractCode
c
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "callvalue" a => a
#callvalue (W256 -> Expr 'EWord
Lit W256
xValue)
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "caller" a => a
#caller (Addr -> Expr 'EWord
litAddr Addr
self)
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall (a :: OpticKind). IsLabel "gas" a => a
#gas Word64
xGas'
replaceCode :: Addr -> ContractCode -> EVM ()
replaceCode :: Addr -> ContractCode -> EVM ()
replaceCode Addr
target ContractCode
newCode =
forall (m :: OpticKind -> OpticKind) (n :: OpticKind -> OpticKind)
(s :: OpticKind) (t :: OpticKind) (k :: OpticKind) (is :: IxList)
(c :: OpticKind).
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
target) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Just Contract
now -> case Contract
now.contractcode of
InitCode ByteString
_ Expr 'Buf
_ ->
forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
s -> m ()
put forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$
(ContractCode -> Contract
initialContract ContractCode
newCode)
{ $sel:balance:Contract :: W256
balance = Contract
now.balance
, $sel:nonce:Contract :: W256
nonce = Contract
now.nonce
}
RuntimeCode RuntimeCode
_ ->
forall a. HasCallStack => [Char] -> a
error ([Char]
"internal error: can't replace code of deployed contract " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> [Char]
show Addr
target)
Maybe Contract
Nothing ->
forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: can't replace code of nonexistent contract"
replaceCodeOfSelf :: ContractCode -> EVM ()
replaceCodeOfSelf :: ContractCode -> EVM ()
replaceCodeOfSelf ContractCode
newCode = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
Addr -> ContractCode -> EVM ()
replaceCode VM
vm.state.contract ContractCode
newCode
resetState :: EVM ()
resetState :: EVM ()
resetState =
forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
(s -> s) -> m ()
modify' forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \VM
vm -> VM
vm { $sel:result:VM :: Maybe VMResult
result = forall (a :: OpticKind). Maybe a
Nothing
, $sel:frames:VM :: [Frame]
frames = []
, $sel:state:VM :: FrameState
state = FrameState
blankState }
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 = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result (forall (a :: OpticKind). 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 = forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap forall (a :: EType). Typeable a => Expr a -> SomeExpr
SomeExpr
underrun :: EVM ()
underrun :: EVM ()
underrun = EvmError -> EVM ()
vmError EvmError
StackUnderrun
data FrameResult
= FrameReturned (Expr Buf)
| FrameReverted (Expr Buf)
| FrameErrored EvmError
deriving Int -> FrameResult -> ShowS
[FrameResult] -> ShowS
FrameResult -> [Char]
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FrameResult] -> ShowS
$cshowList :: [FrameResult] -> ShowS
show :: FrameResult -> [Char]
$cshow :: FrameResult -> [Char]
showsPrec :: Int -> FrameResult -> ShowS
$cshowsPrec :: Int -> FrameResult -> ShowS
Show
finishFrame :: FrameResult -> EVM ()
finishFrame :: FrameResult -> EVM ()
finishFrame FrameResult
how = do
VM
oldVm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
case VM
oldVm.frames of
[] -> do
case FrameResult
how of
FrameReturned Expr 'Buf
output -> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Expr 'Buf -> VMResult
VMSuccess Expr 'Buf
output
FrameReverted Expr 'Buf
buffer -> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> VMResult
VMFailure (Expr 'Buf -> EvmError
Revert Expr 'Buf
buffer)
FrameErrored EvmError
e -> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "result" a => a
#result forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). a -> Maybe a
Just forall (a :: OpticKind) b. (a -> b) -> a -> b
$ EvmError -> VMResult
VMFailure EvmError
e
EVM ()
finalize
Frame
nextFrame : [Frame]
remainingFrames -> do
TraceData -> EVM ()
insertTrace forall (a :: OpticKind) 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
EVM ()
popTrace
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "frames" a => a
#frames [Frame]
remainingFrames
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign forall (a :: OpticKind). IsLabel "state" a => a
#state Frame
nextFrame.state
let remainingGas :: Word64
remainingGas = VM
oldVm.state.gas
reclaimRemainingGasAllowance :: EVM ()
reclaimRemainingGasAllowance = do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall (a :: OpticKind). IsLabel "burned" a => a
#burned (forall (a :: OpticKind). Num a => a -> a -> a
subtract Word64
remainingGas)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "gas" a => a
#gas) (forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
remainingGas)
case Frame
nextFrame.context of
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
[Addr]
touched <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "touchedAccounts" a => a
#touchedAccounts)
let
substate'' :: SubState
substate'' = forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall (a :: OpticKind). IsLabel "touchedAccounts" a => a
#touchedAccounts (forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe forall (a :: OpticKind). a -> a
id forall (s :: OpticKind) (a :: OpticKind).
Cons s s a a =>
a -> s -> s
cons (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find (Addr
3 ==) [Addr]
touched)) SubState
substate'
(Map Addr Contract
contractsReversion, Expr 'Storage
storageReversion) = (Map Addr Contract, Expr 'Storage)
reversion
revertContracts :: EVM ()
revertContracts = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts) Map Addr Contract
contractsReversion
revertStorage :: EVM ()
revertStorage = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "storage" a => a
#storage) Expr 'Storage
storageReversion
revertSubstate :: EVM ()
revertSubstate = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate) SubState
substate''
case FrameResult
how of
FrameReturned Expr 'Buf
output -> do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#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
FrameReverted Expr 'Buf
output -> do
EVM ()
revertContracts
EVM ()
revertStorage
EVM ()
revertSubstate
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#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
FrameErrored EvmError
_ -> do
EVM ()
revertContracts
EVM ()
revertStorage
EVM ()
revertSubstate
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
W256 -> EVM ()
push W256
0
CreationContext Addr
_ Expr 'EWord
_ Map Addr Contract
reversion SubState
substate' -> do
Addr
creator <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contract" a => a
#contract)
let
createe :: Addr
createe = VM
oldVm.state.contract
revertContracts :: EVM ()
revertContracts = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts) Map Addr Contract
reversion'
revertSubstate :: EVM ()
revertSubstate = forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "tx" a => a
#tx forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "substate" a => a
#substate) SubState
substate'
reversion' :: Map Addr Contract
reversion' = (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
(a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
(t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce (forall (a :: OpticKind). Num a => a -> a -> a
+ W256
1)) Addr
creator) Map Addr Contract
reversion
case FrameResult
how of
FrameReturned Expr 'Buf
output -> do
let onContractCode :: ContractCode -> EVM ()
onContractCode ContractCode
contractCode = do
Addr -> ContractCode -> EVM ()
replaceCode Addr
createe ContractCode
contractCode
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
EVM ()
reclaimRemainingGasAllowance
W256 -> EVM ()
push (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
createe)
case Expr 'Buf
output of
ConcreteBuf ByteString
bs ->
ContractCode -> EVM ()
onContractCode forall (a :: OpticKind) 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg
VM
oldVm.state.pc
[Char]
"runtime code cannot have an abstract length"
(forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
output])
Just Vector (Expr 'Byte)
newCode -> do
ContractCode -> EVM ()
onContractCode forall (a :: OpticKind) b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
newCode)
FrameReverted Expr 'Buf
output -> do
EVM ()
revertContracts
EVM ()
revertSubstate
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) Expr 'Buf
output
EVM ()
reclaimRemainingGasAllowance
W256 -> EVM ()
push W256
0
FrameErrored EvmError
_ -> do
EVM ()
revertContracts
EVM ()
revertSubstate
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "returndata" a => a
#returndata) forall (a :: OpticKind). Monoid a => a
mempty
W256 -> EVM ()
push W256
0
accessUnboundedMemoryRange
:: Word64
-> Word64
-> EVM ()
-> EVM ()
accessUnboundedMemoryRange :: Word64 -> Word64 -> EVM () -> EVM ()
accessUnboundedMemoryRange Word64
_ Word64
0 EVM ()
continue = EVM ()
continue
accessUnboundedMemoryRange Word64
f Word64
l EVM ()
continue = do
Word64
m0 <- forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memorySize" a => a
#memorySize)
FeeSchedule Word64
fees <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind)
(a :: OpticKind).
MonadState s m =>
(s -> a) -> m a
gets (.block.schedule)
let m1 :: Word64
m1 = Word64
32 forall (a :: OpticKind). Num a => a -> a -> a
* forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind). Ord a => a -> a -> a
max Word64
m0 (Word64
f forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
l)) Word64
32
Word64 -> EVM () -> EVM ()
burn (FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m1 forall (a :: OpticKind). Num a => a -> a -> a
- FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m0) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memorySize" a => a
#memorySize) Word64
m1
EVM ()
continue
accessMemoryRange
:: W256
-> W256
-> EVM ()
-> EVM ()
accessMemoryRange :: W256 -> W256 -> EVM () -> EVM ()
accessMemoryRange W256
_ W256
0 EVM ()
continue = EVM ()
continue
accessMemoryRange W256
f W256
l EVM ()
continue =
case (,) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> W256 -> Maybe Word64
toWord64 W256
f forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
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 forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
l64 forall (a :: OpticKind). 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 forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256 -> Expr 'EWord
Lit W256
0 then forall (m :: OpticKind -> OpticKind). Monad m => m ()
noop
else do
Expr 'Buf
mem <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
xOffset Expr 'EWord
yOffset Expr 'EWord
size Expr 'Buf
bs Expr 'Buf
mem
copyCallBytesToMemory
:: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM ()
copyCallBytesToMemory :: Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM ()
copyCallBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
xOffset Expr 'EWord
yOffset =
if Expr 'EWord
size forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256 -> Expr 'EWord
Lit W256
0 then forall (m :: OpticKind -> OpticKind). Monad m => m ()
noop
else do
Expr 'Buf
mem <- forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "memory" a => a
#memory) forall (a :: OpticKind) b. (a -> b) -> a -> b
$
Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
xOffset Expr 'EWord
yOffset (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.min Expr 'EWord
size (Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
bs)) Expr 'Buf
bs Expr 'Buf
mem
readMemory :: Expr EWord -> Expr EWord -> VM -> Expr Buf
readMemory :: Expr 'EWord -> Expr 'EWord -> VM -> Expr 'Buf
readMemory Expr 'EWord
offset Expr 'EWord
size VM
vm = Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
offset (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
size VM
vm.state.memory forall (a :: OpticKind). Monoid a => a
mempty
withTraceLocation :: TraceData -> EVM Trace
withTraceLocation :: TraceData -> EVM Trace
withTraceLocation TraceData
x = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
let this :: Contract
this = forall (a :: OpticKind). HasCallStack => Maybe a -> a
fromJust forall (a :: OpticKind) b. (a -> b) -> a -> b
$ VM -> Maybe Contract
currentContract VM
vm
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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 = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe Int
0 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Contract
this.opIxMap forall (a :: OpticKind). 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
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall (a :: OpticKind). IsLabel "traces" a => a
#traces forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\TreePos Empty Trace
t -> forall (a :: OpticKind). TreePos Full a -> TreePos Empty a
Zipper.children forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind).
Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (forall (a :: OpticKind). a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t
insertTrace :: TraceData -> EVM ()
insertTrace :: TraceData -> EVM ()
insertTrace TraceData
x = do
Trace
trace <- TraceData -> EVM Trace
withTraceLocation TraceData
x
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall (a :: OpticKind). IsLabel "traces" a => a
#traces forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\TreePos Empty Trace
t -> forall (a :: OpticKind). TreePos Full a -> TreePos Empty a
Zipper.nextSpace forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind).
Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (forall (a :: OpticKind). a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t
popTrace :: EVM ()
popTrace :: EVM ()
popTrace =
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall (a :: OpticKind). IsLabel "traces" a => a
#traces forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\TreePos Empty Trace
t -> case forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
Zipper.parent TreePos Empty Trace
t of
Maybe (TreePos Full Trace)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"internal error (trace root)"
Just TreePos Full Trace
t' -> forall (a :: OpticKind). TreePos Full a -> TreePos Empty a
Zipper.nextSpace TreePos Full Trace
t'
zipperRootForest :: Zipper.TreePos Zipper.Empty a -> Forest a
zipperRootForest :: forall (a :: OpticKind). TreePos Empty a -> Forest a
zipperRootForest TreePos Empty a
z =
case forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
Zipper.parent TreePos Empty a
z of
Maybe (TreePos Full a)
Nothing -> forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
PosType t =>
TreePos t a -> Forest a
Zipper.toForest TreePos Empty a
z
Just TreePos Full a
z' -> forall (a :: OpticKind). TreePos Empty a -> Forest a
zipperRootForest (forall (a :: OpticKind). TreePos Full a -> TreePos Empty a
Zipper.nextSpace TreePos Full a
z')
traceForest :: VM -> Forest Trace
traceForest :: VM -> Forest Trace
traceForest VM
vm = forall (a :: OpticKind). TreePos Empty a -> Forest a
zipperRootForest VM
vm.traces
traceTopLog :: [Expr Log] -> EVM ()
traceTopLog :: [Expr 'Log] -> EVM ()
traceTopLog [] = forall (m :: OpticKind -> OpticKind). Monad m => m ()
noop
traceTopLog ((LogEntry Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics) : [Expr 'Log]
_) = do
Trace
trace <- TraceData -> EVM Trace
withTraceLocation (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> TraceData
EventTrace Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics)
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying forall (a :: OpticKind). IsLabel "traces" a => a
#traces forall (a :: OpticKind) b. (a -> b) -> a -> b
$
\TreePos Empty Trace
t -> forall (a :: OpticKind). TreePos Full a -> TreePos Empty a
Zipper.nextSpace (forall (a :: OpticKind).
Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (forall (a :: OpticKind). a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t)
traceTopLog ((GVar GVar 'Log
_) : [Expr 'Log]
_) = forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected global variable"
push :: W256 -> EVM ()
push :: W256 -> EVM ()
push = Expr 'EWord -> EVM ()
pushSym forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. W256 -> Expr 'EWord
Lit
pushSym :: Expr EWord -> EVM ()
pushSym :: Expr 'EWord -> EVM ()
pushSym Expr 'EWord
x = forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(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 =
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Expr 'EWord
x:[Expr 'EWord]
xs ->
Word64 -> EVM () -> EVM ()
burn Word64
cost forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
let !y :: Expr 'EWord
y = Expr 'EWord -> Expr 'EWord
f Expr 'EWord
x
(forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Expr 'EWord
y forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs
[Expr 'EWord]
_ ->
EVM ()
underrun
stackOp2
:: (?op :: Word8)
=> Word64
-> (((Expr EWord), (Expr EWord)) -> (Expr EWord))
-> EVM ()
stackOp2 :: (?op::Word8) =>
Word64 -> ((Expr 'EWord, Expr 'EWord) -> Expr 'EWord) -> EVM ()
stackOp2 Word64
cost (Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f =
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs ->
Word64 -> EVM () -> EVM ()
burn Word64
cost forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
(forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(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) forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs
[Expr 'EWord]
_ ->
EVM ()
underrun
stackOp3
:: (?op :: Word8)
=> Word64
-> (((Expr EWord), (Expr EWord), (Expr EWord)) -> (Expr EWord))
-> EVM ()
stackOp3 :: (?op::Word8) =>
Word64
-> ((Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord)
-> EVM ()
stackOp3 Word64
cost (Expr 'EWord, Expr 'EWord, Expr 'EWord) -> Expr 'EWord
f =
forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind).
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \case
Expr 'EWord
x:Expr 'EWord
y:Expr 'EWord
z:[Expr 'EWord]
xs ->
Word64 -> EVM () -> EVM ()
burn Word64
cost forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
(?op::Word8) => EVM ()
next
(forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "stack" a => a
#stack) forall (k :: OpticKind) (s :: OpticKind)
(m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
(b :: OpticKind).
(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) forall (a :: OpticKind). a -> [a] -> [a]
: [Expr 'EWord]
xs
[Expr 'EWord]
_ ->
EVM ()
underrun
use' :: (VM -> a) -> EVM a
use' :: forall (a :: OpticKind). (VM -> a) -> EVM a
use' VM -> a
f = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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 <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
case VM -> Int -> Bool
isValidJumpDest VM
vm Int
x of
Bool
True -> do
#state % #stack .= xs
#state % #pc .= num 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 = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe
(forall a. HasCallStack => [Char] -> a
error [Char]
"Internal Error: self not found in current contracts")
(forall (k :: OpticKind) (a :: OpticKind).
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 forall (a :: OpticKind). Vector a -> Int -> Maybe a
V.!? Int
x forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
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 forall (a :: OpticKind). Eq a => a -> a -> Bool
== Word8
b Bool -> Bool -> Bool
&& forall (a :: OpticKind). GenericOp a
OpJumpdest forall (a :: OpticKind). Eq a => a -> a -> Bool
== forall (a :: OpticKind) (b :: OpticKind). (a, b) -> b
snd (Contract
contract.codeOps forall (a :: OpticKind). Vector a -> Int -> a
V.! (Contract
contract.opIxMap forall (a :: OpticKind). Storable a => Vector a -> Int -> a
SV.! forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Int
x))
opSize :: Word8 -> Int
opSize :: Word8 -> Int
opSize Word8
x | Word8
x forall (a :: OpticKind). Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x forall (a :: OpticKind). Ord a => a -> a -> Bool
<= Word8
0x7f = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word8
x forall (a :: OpticKind). Num a => a -> a -> a
- Int
0x60 forall (a :: OpticKind). Num a => a -> a -> a
+ Int
2
opSize Word8
_ = Int
1
mkOpIxMap :: ContractCode -> SV.Vector Int
mkOpIxMap :: ContractCode -> Vector Int
mkOpIxMap (InitCode ByteString
conc Expr 'Buf
_)
= forall (a :: OpticKind).
Storable a =>
(forall (s :: OpticKind). ST s (MVector s a)) -> Vector a
SV.create forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
SV.new (ByteString -> Int
BS.length ByteString
conc) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
let (Word8
_, Int
_, Int
_, ST s ()
m) = forall (a :: OpticKind). (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (forall {a :: OpticKind} {m :: OpticKind -> OpticKind}
{a :: OpticKind} {a :: OpticKind}.
(Ord a, PrimMonad m, Storable a, Num a, Num a) =>
MVector (PrimState m) a
-> (a, Int, a, m a) -> a -> (a, Int, a, m ())
go MVector s Int
v) (Word8
0 :: Word8, Int
0, Int
0, forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()) ByteString
conc
in ST s ()
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure MVector s Int
v
where
go :: MVector (PrimState m) a
-> (a, Int, a, m a) -> a -> (a, Int, a, m ())
go MVector (PrimState m) a
v (a
0, !Int
i, !a
j, !m a
m) a
x | a
x forall (a :: OpticKind). Ord a => a -> a -> Bool
>= a
0x60 Bool -> Bool -> Bool
&& a
x forall (a :: OpticKind). Ord a => a -> a -> Bool
<= a
0x7f =
(a
x forall (a :: OpticKind). Num a => a -> a -> a
- a
0x60 forall (a :: OpticKind). Num a => a -> a -> a
+ a
1, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(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
_ =
(a
0, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j forall (a :: OpticKind). Num a => a -> a -> a
+ a
1, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(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
_ =
(a
0, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j forall (a :: OpticKind). Num a => a -> a -> a
+ a
1, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(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
_ =
(a
n forall (a :: OpticKind). Num a => a -> a -> a
- a
1, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(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 forall (a :: OpticKind). Monoid a => a
mempty)
mkOpIxMap (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops))
= forall (a :: OpticKind).
Storable a =>
(forall (s :: OpticKind). ST s (MVector s a)) -> Vector a
SV.create forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
SV.new (forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length Vector (Expr 'Byte)
ops) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
let (Word8
_, Int
_, Int
_, ST s ()
m) = forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
(a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {m :: OpticKind -> OpticKind} {a :: OpticKind}
{a :: OpticKind}.
(PrimMonad m, Storable a, Num a, Show a) =>
MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector s Int
v) (Word8
0, Int
0, Int
0, forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ()) ([Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops)
in ST s ()
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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' forall (a :: OpticKind). Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x' forall (a :: OpticKind). Ord a => a -> a -> Bool
<= Word8
0x7f
then (Word8
x' forall (a :: OpticKind). Num a => a -> a -> a
- Word8
0x60 forall (a :: OpticKind). Num a => a -> a -> a
+ Word8
1, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
else (Word8
0, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j forall (a :: OpticKind). Num a => a -> a -> a
+ a
1, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
Maybe Word8
_ -> forall a. HasCallStack => [Char] -> a
error forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Char]
"cannot analyze symbolic code:\nx: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> [Char]
show Expr 'Byte
x forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Char]
" i: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> [Char]
show Int
i forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Char]
" j: " forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> [Char]
show a
j
go MVector (PrimState m) a
v (Word8
1, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
(Word8
0, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j forall (a :: OpticKind). Num a => a -> a -> a
+ a
1, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(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
_ =
(Word8
n forall (a :: OpticKind). Num a => a -> a -> a
- Word8
1, Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
1, a
j, m a
m forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Monad m =>
m a -> m b -> m b
>> forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
(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 forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
(a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "pc" a => a
#pc
code' :: ContractCode
code' = VM
vm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
(a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "state" a => a
#state forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
(is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
(t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
(b :: OpticKind).
(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
% forall (a :: OpticKind). IsLabel "code" a => a
#code
(Word8
op, [Expr 'Byte]
pushdata) = case ContractCode
code' of
InitCode ByteString
xs' Expr 'Buf
_ ->
(HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
RuntimeCode (ConcreteRuntimeCode ByteString
xs') ->
(HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
xs') ->
( forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected symbolic code") forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Expr 'Byte -> Maybe Word8
maybeLitByte forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
xs' forall (a :: OpticKind). Vector a -> Int -> a
V.! Int
i , forall (a :: OpticKind). Vector a -> [a]
V.toList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Int -> Vector a -> Vector a
V.drop Int
i Vector (Expr 'Byte)
xs')
in if (ContractCode -> Int
opslen ContractCode
code' forall (a :: OpticKind). Ord a => a -> a -> Bool
< Int
i)
then forall (a :: OpticKind). Maybe a
Nothing
else forall (a :: OpticKind). 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 forall (a :: OpticKind). Storable a => Vector a -> Int -> Maybe a
SV.!? VM
vm.state.pc
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 forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> (ByteString -> [Word8]
BS.unpack ByteString
bytes)
RuntimeCode (ConcreteRuntimeCode ByteString
ops) ->
Word8 -> Expr 'Byte
LitByte forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
(b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> (ByteString -> [Word8]
BS.unpack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripBytecodeMetadata ByteString
ops)
RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
[Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops
in forall (a :: OpticKind). [a] -> Vector a
V.fromList forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> [a]
toList forall (a :: OpticKind) 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 forall (s :: OpticKind) (a :: OpticKind).
Cons s s a a =>
s -> Maybe (a, s)
uncons [Expr 'Byte]
xs of
Maybe (Expr 'Byte, [Expr 'Byte])
Nothing ->
forall (a :: OpticKind). Monoid a => a
mempty
Just (Expr 'Byte
x, [Expr 'Byte]
xs') ->
let x' :: Word8
x' = forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected symbolic code argument") forall (a :: OpticKind) 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') forall (a :: OpticKind). a -> Seq a -> Seq a
Seq.<| Int -> [Expr 'Byte] -> Seq (Int, GenericOp (Expr 'EWord))
go (Int
i forall (a :: OpticKind). Num a => a -> a -> a
+ Int
j) (forall (a :: OpticKind). Int -> [a] -> [a]
drop Int
j [Expr 'Byte]
xs)
costOfCall
:: FeeSchedule Word64
-> Bool -> W256 -> Word64 -> Word64 -> Addr
-> EVM (Word64, Word64)
costOfCall :: FeeSchedule Word64
-> Bool -> W256 -> Word64 -> Word64 -> Addr -> EVM (Word64, Word64)
costOfCall (FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_initcodeword :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
..}) Bool
recipientExists W256
xValue Word64
availableGas Word64
xGas Addr
target = do
Bool
acc <- Addr -> EVM Bool
accessAccountForGas Addr
target
let call_base_gas :: Word64
call_base_gas = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
c_new :: Word64
c_new = if Bool -> Bool
not Bool
recipientExists Bool -> Bool -> Bool
&& W256
xValue forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0
then Word64
g_newaccount
else Word64
0
c_xfer :: Word64
c_xfer = if W256
xValue forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0 then forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Word64
g_callvalue else Word64
0
c_extra :: Word64
c_extra = Word64
call_base_gas forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
c_xfer forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
c_new
c_gascap :: Word64
c_gascap = if Word64
availableGas forall (a :: OpticKind). Ord a => a -> a -> Bool
>= Word64
c_extra
then forall (a :: OpticKind). Ord a => a -> a -> a
min Word64
xGas (forall (a :: OpticKind). (Num a, Integral a) => a -> a
allButOne64th (Word64
availableGas forall (a :: OpticKind). Num a => a -> a -> a
- Word64
c_extra))
else Word64
xGas
c_callgas :: Word64
c_callgas = if W256
xValue forall (a :: OpticKind). Eq a => a -> a -> Bool
/= W256
0 then Word64
c_gascap forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_callstipend else Word64
c_gascap
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Word64
c_gascap forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
c_extra, Word64
c_callgas)
costOfCreate
:: FeeSchedule Word64
-> Word64 -> W256 -> Bool -> (Word64, Word64)
costOfCreate :: FeeSchedule Word64 -> Word64 -> W256 -> Bool -> (Word64, Word64)
costOfCreate (FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_initcodeword :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
..}) Word64
availableGas W256
size Bool
hashNeeded = (Word64
createCost, Word64
initGas)
where
byteCost :: Word64
byteCost = if Bool
hashNeeded then Word64
g_sha3word forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_initcodeword else Word64
g_initcodeword
createCost :: Word64
createCost = Word64
g_create forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
codeCost
codeCost :: Word64
codeCost = Word64
byteCost forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
size) Word64
32)
initGas :: Word64
initGas = forall (a :: OpticKind). (Num a, Integral a) => a -> a
allButOne64th (Word64
availableGas forall (a :: OpticKind). Num a => a -> a -> a
- Word64
createCost)
concreteModexpGasFee :: ByteString -> Word64
concreteModexpGasFee :: ByteString -> Word64
concreteModexpGasFee ByteString
input =
if W256
lenb forall (a :: OpticKind). Ord a => a -> a -> Bool
< forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (a :: OpticKind). Bounded a => a
maxBound :: Word32) Bool -> Bool -> Bool
&&
(W256
lene forall (a :: OpticKind). Ord a => a -> a -> Bool
< forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (a :: OpticKind). Bounded a => a
maxBound :: Word32) Bool -> Bool -> Bool
|| (W256
lenb forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0 Bool -> Bool -> Bool
&& W256
lenm forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0)) Bool -> Bool -> Bool
&&
W256
lenm forall (a :: OpticKind). Ord a => a -> a -> Bool
< forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (a :: OpticKind). Bounded a => a
maxBound :: Word64)
then
forall (a :: OpticKind). Ord a => a -> a -> a
max Word64
200 ((Word64
multiplicationComplexity forall (a :: OpticKind). Num a => a -> a -> a
* Word64
iterCount) forall (a :: OpticKind). Integral a => a -> a -> a
`div` Word64
3)
else
forall (a :: OpticKind). Bounded a => a
maxBound
where
(W256
lenb, W256
lene, W256
lenm) = ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input
ez :: Bool
ez = W256 -> W256 -> ByteString -> Bool
isZero (W256
96 forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input
e' :: W256
e' = ByteString -> W256
word forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict forall (a :: OpticKind) b. (a -> b) -> a -> b
$
W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 forall (a :: OpticKind). Num a => a -> a -> a
+ W256
lenb) (forall (a :: OpticKind). Ord a => a -> a -> a
min W256
32 W256
lene) ByteString
input
nwords :: Word64
nwords :: Word64
nwords = forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Ord a => a -> a -> a
max W256
lenb W256
lenm) Word64
8
multiplicationComplexity :: Word64
multiplicationComplexity = Word64
nwords forall (a :: OpticKind). Num a => a -> a -> a
* Word64
nwords
iterCount' :: Word64
iterCount' :: Word64
iterCount' | W256
lene forall (a :: OpticKind). Ord a => a -> a -> Bool
<= W256
32 Bool -> Bool -> Bool
&& Bool
ez = Word64
0
| W256
lene forall (a :: OpticKind). Ord a => a -> a -> Bool
<= W256
32 = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (b :: OpticKind). FiniteBits b => b -> Int
log2 W256
e')
| W256
e' forall (a :: OpticKind). Eq a => a -> a -> Bool
== W256
0 = Word64
8 forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
lene forall (a :: OpticKind). Num a => a -> a -> a
- Word64
32)
| Bool
otherwise = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num (forall (b :: OpticKind). FiniteBits b => b -> Int
log2 W256
e') forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
8 forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
lene forall (a :: OpticKind). Num a => a -> a -> a
- Word64
32)
iterCount :: Word64
iterCount = forall (a :: OpticKind). Ord a => a -> a -> a
max Word64
iterCount' Word64
1
costOfPrecompile :: FeeSchedule Word64 -> Addr -> Expr Buf -> Word64
costOfPrecompile :: FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile (FeeSchedule {Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_initcodeword :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
..}) Addr
precompileAddr Expr 'Buf
input =
let errorDynamicSize :: a
errorDynamicSize = forall a. HasCallStack => [Char] -> a
error [Char]
"precompile input cannot have a dynamic size"
inputLen :: Word64
inputLen = case Expr 'Buf
input of
ConcreteBuf ByteString
bs -> forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
AbstractBuf Text
_ -> forall {a :: OpticKind}. a
errorDynamicSize
Expr 'Buf
buf -> case Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
buf of
Lit W256
l -> forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num W256
l
Expr 'EWord
_ -> forall {a :: OpticKind}. a
errorDynamicSize
in case Addr
precompileAddr of
Addr
0x1 -> Word64
3000
Addr
0x2 -> forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (((Word64
inputLen forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
31) forall (a :: OpticKind). Integral a => a -> a -> a
`div` Word64
32) forall (a :: OpticKind). Num a => a -> a -> a
* Word64
12) forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
60
Addr
0x3 -> forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (((Word64
inputLen forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
31) forall (a :: OpticKind). Integral a => a -> a -> a
`div` Word64
32) forall (a :: OpticKind). Num a => a -> a -> a
* Word64
120) forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
600
Addr
0x4 -> forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (((Word64
inputLen forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
31) forall (a :: OpticKind). Integral a => a -> a -> a
`div` Word64
32) forall (a :: OpticKind). Num a => a -> a -> a
* Word64
3) forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
15
Addr
0x5 -> case Expr 'Buf
input of
ConcreteBuf ByteString
i -> ByteString -> Word64
concreteModexpGasFee ByteString
i
Expr 'Buf
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsupported symbolic modexp gas calc "
Addr
0x6 -> Word64
g_ecadd
Addr
0x7 -> Word64
g_ecmul
Addr
0x8 -> (Word64
inputLen forall (a :: OpticKind). Integral a => a -> a -> a
`div` Word64
192) forall (a :: OpticKind). Num a => a -> a -> a
* Word64
g_pairing_point forall (a :: OpticKind). Num a => a -> a -> a
+ Word64
g_pairing_base
Addr
0x9 -> case Expr 'Buf
input of
ConcreteBuf ByteString
i -> Word64
g_fround forall (a :: OpticKind). Num a => a -> a -> a
* (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> Integer
asInteger forall (a :: OpticKind) b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
0 W256
4 ByteString
i)
Expr 'Buf
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unsupported symbolic blake2 gas calc"
Addr
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"unimplemented precompiled contract " forall (a :: OpticKind). [a] -> [a] -> [a]
++ forall (a :: OpticKind). Show a => a -> [Char]
show Addr
precompileAddr)
memoryCost :: FeeSchedule Word64 -> Word64 -> Word64
memoryCost :: FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule{Word64
g_access_list_storage_key :: Word64
g_access_list_address :: Word64
g_warm_storage_read :: Word64
g_cold_account_access :: Word64
g_cold_sload :: Word64
r_block :: Word64
g_fround :: Word64
g_pairing_base :: Word64
g_pairing_point :: Word64
g_ecmul :: Word64
g_ecadd :: Word64
g_quaddivisor :: Word64
g_extcodehash :: Word64
g_blockhash :: Word64
g_copy :: Word64
g_initcodeword :: Word64
g_sha3word :: Word64
g_sha3 :: Word64
g_logtopic :: Word64
g_logdata :: Word64
g_log :: Word64
g_transaction :: Word64
g_txdatanonzero :: Word64
g_txdatazero :: Word64
g_txcreate :: Word64
g_memory :: Word64
g_expbyte :: Word64
g_exp :: Word64
g_newaccount :: Word64
g_callstipend :: Word64
g_callvalue :: Word64
g_call :: Word64
g_codedeposit :: Word64
g_create :: Word64
r_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
g_selfdestruct :: Word64
r_sclear :: Word64
g_sreset :: Word64
g_sset :: Word64
g_jumpdest :: Word64
g_sload :: Word64
g_balance :: Word64
g_extcode :: Word64
g_high :: Word64
g_mid :: Word64
g_low :: Word64
g_verylow :: Word64
g_base :: Word64
g_zero :: Word64
$sel:g_access_list_storage_key:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
$sel:g_zero:FeeSchedule :: forall (n :: OpticKind). FeeSchedule n -> n
..} Word64
byteCount =
let
wordCount :: Word64
wordCount = forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv Word64
byteCount Word64
32
linearCost :: Word64
linearCost = Word64
g_memory forall (a :: OpticKind). Num a => a -> a -> a
* Word64
wordCount
quadraticCost :: Word64
quadraticCost = forall (a :: OpticKind). Integral a => a -> a -> a
div (Word64
wordCount forall (a :: OpticKind). Num a => a -> a -> a
* Word64
wordCount) Word64
512
in
Word64
linearCost forall (a :: OpticKind). 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 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops) forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Expr 'Buf
args
hashcode (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = Expr 'Buf -> Expr 'EWord
keccak (ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops)
hashcode (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Expr 'Buf -> Expr 'EWord
keccak forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops
opslen :: ContractCode -> Int
opslen :: ContractCode -> Int
opslen (InitCode ByteString
ops Expr 'Buf
_) = ByteString -> Int
BS.length ByteString
ops
opslen (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = ByteString -> Int
BS.length ByteString
ops
opslen (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length Vector (Expr 'Byte)
ops
codelen :: ContractCode -> Expr EWord
codelen :: ContractCode -> Expr 'EWord
codelen c :: ContractCode
c@(InitCode {}) = Expr 'Buf -> Expr 'EWord
bufLength forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ContractCode -> Expr 'Buf
toBuf ContractCode
c
codelen (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = W256 -> Expr 'EWord
Lit forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
ops
codelen (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = W256 -> Expr 'EWord
Lit forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length Vector (Expr 'Byte)
ops
toBuf :: ContractCode -> Expr Buf
toBuf :: ContractCode -> Expr 'Buf
toBuf (InitCode ByteString
ops Expr 'Buf
args) = ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Expr 'Buf
args
toBuf (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops
toBuf (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList Vector (Expr 'Byte)
ops
codeloc :: EVM CodeLocation
codeloc :: EVM CodeLocation
codeloc = do
VM
vm <- forall (s :: OpticKind) (m :: OpticKind -> OpticKind).
MonadState s m =>
m s
get
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (VM
vm.state.contract, VM
vm.state.pc)
ceilDiv :: (Num a, Integral a) => a -> a -> a
ceilDiv :: forall (a :: OpticKind). (Num a, Integral a) => a -> a -> a
ceilDiv a
m a
n = forall (a :: OpticKind). Integral a => a -> a -> a
div (a
m forall (a :: OpticKind). Num a => a -> a -> a
+ a
n forall (a :: OpticKind). Num a => a -> a -> a
- a
1) a
n
allButOne64th :: (Num a, Integral a) => a -> a
allButOne64th :: forall (a :: OpticKind). (Num a, Integral a) => a -> a
allButOne64th a
n = a
n forall (a :: OpticKind). Num a => a -> a -> a
- forall (a :: OpticKind). Integral a => a -> a -> a
div a
n a
64
log2 :: FiniteBits b => b -> Int
log2 :: forall (b :: OpticKind). FiniteBits b => b -> Int
log2 b
x = forall (b :: OpticKind). FiniteBits b => b -> Int
finiteBitSize b
x forall (a :: OpticKind). Num a => a -> a -> a
- Int
1 forall (a :: OpticKind). Num a => a -> a -> a
- forall (b :: OpticKind). FiniteBits b => b -> Int
countLeadingZeros b
x