module EVM.Transaction where

import Prelude hiding (Word)

import qualified EVM
import EVM (balance, initialContract)
import EVM.FeeSchedule
import EVM.Precompiled (execute)
import EVM.RLP
import EVM.Symbolic (forceLit)
import EVM.Types

import Control.Lens

import Data.Aeson (FromJSON (..))
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.Maybe (fromMaybe, isNothing, isJust)

import qualified Data.Aeson        as JSON
import qualified Data.Aeson.Types  as JSON
import qualified Data.ByteString   as BS
import qualified Data.Map          as Map

data AccessListEntry = AccessListEntry {
  AccessListEntry -> Addr
accessAddress :: Addr,
  AccessListEntry -> [W256]
accessStorageKeys :: [W256]
} deriving Int -> AccessListEntry -> ShowS
[AccessListEntry] -> ShowS
AccessListEntry -> String
(Int -> AccessListEntry -> ShowS)
-> (AccessListEntry -> String)
-> ([AccessListEntry] -> ShowS)
-> Show AccessListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessListEntry] -> ShowS
$cshowList :: [AccessListEntry] -> ShowS
show :: AccessListEntry -> String
$cshow :: AccessListEntry -> String
showsPrec :: Int -> AccessListEntry -> ShowS
$cshowsPrec :: Int -> AccessListEntry -> ShowS
Show

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

data Transaction = Transaction {
    Transaction -> ByteString
txData     :: ByteString,
    Transaction -> W256
txGasLimit :: W256,
    Transaction -> W256
txGasPrice :: W256,
    Transaction -> W256
txNonce    :: W256,
    Transaction -> W256
txR        :: W256,
    Transaction -> W256
txS        :: W256,
    Transaction -> Maybe Addr
txToAddr   :: Maybe Addr,
    Transaction -> W256
txV        :: W256,
    Transaction -> W256
txValue    :: W256,
    Transaction -> TxType
txType     :: TxType,
    Transaction -> [AccessListEntry]
txAccessList :: [AccessListEntry]
} deriving Int -> Transaction -> ShowS
[Transaction] -> ShowS
Transaction -> String
(Int -> Transaction -> ShowS)
-> (Transaction -> String)
-> ([Transaction] -> ShowS)
-> Show Transaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transaction] -> ShowS
$cshowList :: [Transaction] -> ShowS
show :: Transaction -> String
$cshow :: Transaction -> String
showsPrec :: Int -> Transaction -> ShowS
$cshowsPrec :: Int -> Transaction -> ShowS
Show

-- utility function for getting a more useful representation of accesslistentries
-- duplicates only matter for gas computation
-- ugly! could use a review....
txAccessMap :: Transaction -> Map Addr [W256]
txAccessMap :: Transaction -> Map Addr [W256]
txAccessMap Transaction
tx = ((([W256] -> [W256] -> [W256]) -> [(Addr, [W256])] -> Map Addr [W256]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [W256] -> [W256] -> [W256]
forall a. [a] -> [a] -> [a]
(++)) ([(Addr, [W256])] -> Map Addr [W256])
-> ([AccessListEntry] -> [(Addr, [W256])])
-> [AccessListEntry]
-> Map Addr [W256]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccessListEntry] -> [(Addr, [W256])]
makeTups) ([AccessListEntry] -> Map Addr [W256])
-> [AccessListEntry] -> Map Addr [W256]
forall a b. (a -> b) -> a -> b
$ Transaction -> [AccessListEntry]
txAccessList Transaction
tx
  where makeTups :: [AccessListEntry] -> [(Addr, [W256])]
makeTups = (AccessListEntry -> (Addr, [W256]))
-> [AccessListEntry] -> [(Addr, [W256])]
forall a b. (a -> b) -> [a] -> [b]
map (\AccessListEntry
ale -> (AccessListEntry -> Addr
accessAddress AccessListEntry
ale, AccessListEntry -> [W256]
accessStorageKeys AccessListEntry
ale))

ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr
ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr
ecrec W256
v W256
r W256
s W256
e = W256 -> Addr
forall a b. (Integral a, Num b) => a -> b
num (W256 -> Addr) -> (ByteString -> W256) -> ByteString -> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> W256
word (ByteString -> Addr) -> Maybe ByteString -> Maybe Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
1 ByteString
input Int
32
  where input :: ByteString
input = [ByteString] -> ByteString
BS.concat (W256 -> ByteString
word256Bytes (W256 -> ByteString) -> [W256] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [W256
e, W256
v, W256
r, W256
s])

sender :: Int -> Transaction -> Maybe Addr
sender :: Int -> Transaction -> Maybe Addr
sender Int
chainId Transaction
tx = W256 -> W256 -> W256 -> W256 -> Maybe Addr
ecrec W256
v' (Transaction -> W256
txR Transaction
tx) (Transaction -> W256
txS Transaction
tx) W256
hash
  where hash :: W256
hash = ByteString -> W256
keccak (Int -> Transaction -> ByteString
signingData Int
chainId Transaction
tx)
        v :: W256
v    = Transaction -> W256
txV Transaction
tx
        v' :: W256
v'   = if W256
v W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
27 Bool -> Bool -> Bool
|| W256
v W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
28 then W256
v
               else W256
27 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
v

signingData :: Int -> Transaction -> ByteString
signingData :: Int -> Transaction -> ByteString
signingData Int
chainId Transaction
tx =
  case Transaction -> TxType
txType Transaction
tx of
    TxType
LegacyTransaction -> if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
chainId Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
35) Bool -> Bool -> Bool
|| Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
chainId Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
36)
      then ByteString
eip155Data
      else ByteString
normalData
    TxType
AccessListTransaction -> ByteString
eip2930Data
  where v :: Int
v          = W256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Transaction -> W256
txV Transaction
tx)
        to' :: RLP
to'        = case Transaction -> Maybe Addr
txToAddr Transaction
tx of
          Just Addr
a  -> ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ Addr -> ByteString
word160Bytes Addr
a
          Maybe Addr
Nothing -> ByteString -> RLP
BS ByteString
forall a. Monoid a => a
mempty
        accessList :: [AccessListEntry]
accessList = Transaction -> [AccessListEntry]
txAccessList Transaction
tx
        rlpAccessList :: RLP
rlpAccessList = [RLP] -> RLP
EVM.RLP.List ([RLP] -> RLP) -> [RLP] -> RLP
forall a b. (a -> b) -> a -> b
$ (AccessListEntry -> RLP) -> [AccessListEntry] -> [RLP]
forall a b. (a -> b) -> [a] -> [b]
map (\AccessListEntry
accessEntry ->
          [RLP] -> RLP
EVM.RLP.List [ByteString -> RLP
BS (ByteString -> RLP) -> ByteString -> RLP
forall a b. (a -> b) -> a -> b
$ Addr -> ByteString
word160Bytes (AccessListEntry -> Addr
accessAddress AccessListEntry
accessEntry), 
                        [RLP] -> RLP
EVM.RLP.List ([RLP] -> RLP) -> [RLP] -> RLP
forall a b. (a -> b) -> a -> b
$ (W256 -> RLP) -> [W256] -> [RLP]
forall a b. (a -> b) -> [a] -> [b]
map W256 -> RLP
rlpWordFull ([W256] -> [RLP]) -> [W256] -> [RLP]
forall a b. (a -> b) -> a -> b
$ AccessListEntry -> [W256]
accessStorageKeys AccessListEntry
accessEntry]
          ) [AccessListEntry]
accessList
        normalData :: ByteString
normalData = [RLP] -> ByteString
rlpList [W256 -> RLP
rlpWord256 (Transaction -> W256
txNonce Transaction
tx),
                              W256 -> RLP
rlpWord256 (Transaction -> W256
txGasPrice Transaction
tx),
                              W256 -> RLP
rlpWord256 (Transaction -> W256
txGasLimit Transaction
tx),
                              RLP
to',
                              W256 -> RLP
rlpWord256 (Transaction -> W256
txValue Transaction
tx),
                              ByteString -> RLP
BS (Transaction -> ByteString
txData Transaction
tx)]
        eip155Data :: ByteString
eip155Data = [RLP] -> ByteString
rlpList [W256 -> RLP
rlpWord256 (Transaction -> W256
txNonce Transaction
tx),
                              W256 -> RLP
rlpWord256 (Transaction -> W256
txGasPrice Transaction
tx),
                              W256 -> RLP
rlpWord256 (Transaction -> W256
txGasLimit Transaction
tx),
                              RLP
to',
                              W256 -> RLP
rlpWord256 (Transaction -> W256
txValue Transaction
tx),
                              ByteString -> RLP
BS (Transaction -> ByteString
txData Transaction
tx),
                              W256 -> RLP
rlpWord256 (Int -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chainId),
                              W256 -> RLP
rlpWord256 W256
0x0,
                              W256 -> RLP
rlpWord256 W256
0x0]
        eip2930Data :: ByteString
eip2930Data = Word8 -> ByteString -> ByteString
forall s a. Cons s s a a => a -> s -> s
cons Word8
0x01 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [RLP] -> ByteString
rlpList [
          W256 -> RLP
rlpWord256 (Int -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chainId),
          W256 -> RLP
rlpWord256 (Transaction -> W256
txNonce Transaction
tx),
          W256 -> RLP
rlpWord256 (Transaction -> W256
txGasPrice Transaction
tx),
          W256 -> RLP
rlpWord256 (Transaction -> W256
txGasLimit Transaction
tx),
          RLP
to', 
          W256 -> RLP
rlpWord256 (Transaction -> W256
txValue Transaction
tx),
          ByteString -> RLP
BS (Transaction -> ByteString
txData Transaction
tx),
          RLP
rlpAccessList]

accessListPrice :: FeeSchedule Integer -> [AccessListEntry] -> Integer
accessListPrice :: FeeSchedule Integer -> [AccessListEntry] -> Integer
accessListPrice FeeSchedule Integer
fs [AccessListEntry]
al =
    [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AccessListEntry -> Integer) -> [AccessListEntry] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map 
      (\AccessListEntry
ale -> 
        FeeSchedule Integer -> Integer
forall n. FeeSchedule n -> n
g_access_list_address FeeSchedule Integer
fs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 
        (FeeSchedule Integer -> Integer
forall n. FeeSchedule n -> n
g_access_list_storage_key FeeSchedule Integer
fs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> ([W256] -> Int) -> [W256] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [W256] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (AccessListEntry -> [W256]
accessStorageKeys AccessListEntry
ale))) 
        [AccessListEntry]
al)

txGasCost :: FeeSchedule Integer -> Transaction -> Integer
txGasCost :: FeeSchedule Integer -> Transaction -> Integer
txGasCost FeeSchedule Integer
fs Transaction
tx =
  let calldata :: ByteString
calldata     = Transaction -> ByteString
txData Transaction
tx
      zeroBytes :: Int
zeroBytes    = Word8 -> ByteString -> Int
BS.count Word8
0 ByteString
calldata
      nonZeroBytes :: Int
nonZeroBytes = ByteString -> Int
BS.length ByteString
calldata Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
zeroBytes
      baseCost :: Integer
baseCost     = FeeSchedule Integer -> Integer
forall n. FeeSchedule n -> n
g_transaction FeeSchedule Integer
fs
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ if Maybe Addr -> Bool
forall a. Maybe a -> Bool
isNothing (Transaction -> Maybe Addr
txToAddr Transaction
tx) then FeeSchedule Integer -> Integer
forall n. FeeSchedule n -> n
g_txcreate FeeSchedule Integer
fs else Integer
0
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (FeeSchedule Integer -> [AccessListEntry] -> Integer
accessListPrice FeeSchedule Integer
fs ([AccessListEntry] -> Integer) -> [AccessListEntry] -> Integer
forall a b. (a -> b) -> a -> b
$ Transaction -> [AccessListEntry]
txAccessList Transaction
tx)
      zeroCost :: Integer
zeroCost     = FeeSchedule Integer -> Integer
forall n. FeeSchedule n -> n
g_txdatazero FeeSchedule Integer
fs
      nonZeroCost :: Integer
nonZeroCost  = FeeSchedule Integer -> Integer
forall n. FeeSchedule n -> n
g_txdatanonzero FeeSchedule Integer
fs
  in Integer
baseCost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
zeroCost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
zeroBytes) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nonZeroCost Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nonZeroBytes)

instance FromJSON AccessListEntry where
  parseJSON :: Value -> Parser AccessListEntry
parseJSON (JSON.Object Object
val) = do
    Addr
accessAddress_ <- Object -> Text -> Parser Addr
addrField Object
val Text
"address"
    --storageKeys <- (val JSON..: "storageKeys")
    --accessStorageKeys_ <- JSON.listParser (JSON.withText "W256" (return . readNull 0 . Text.unpack)) storageKeys
    [W256]
accessStorageKeys_ <- (Object
val Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: Text
"storageKeys") Parser Value -> (Value -> Parser [W256]) -> Parser [W256]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser [W256]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
    AccessListEntry -> Parser AccessListEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (AccessListEntry -> Parser AccessListEntry)
-> AccessListEntry -> Parser AccessListEntry
forall a b. (a -> b) -> a -> b
$ Addr -> [W256] -> AccessListEntry
AccessListEntry Addr
accessAddress_ [W256]
accessStorageKeys_
  parseJSON Value
invalid =
    String -> Value -> Parser AccessListEntry
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"AccessListEntry" Value
invalid

instance FromJSON Transaction where
  parseJSON :: Value -> Parser Transaction
parseJSON (JSON.Object Object
val) = do
    ByteString
tdata    <- Object -> Text -> Parser ByteString
dataField Object
val Text
"data"
    W256
gasLimit <- Object -> Text -> Parser W256
wordField Object
val Text
"gasLimit"
    W256
gasPrice <- Object -> Text -> Parser W256
wordField Object
val Text
"gasPrice"
    W256
nonce    <- Object -> Text -> Parser W256
wordField Object
val Text
"nonce"
    W256
r        <- Object -> Text -> Parser W256
wordField Object
val Text
"r"
    W256
s        <- Object -> Text -> Parser W256
wordField Object
val Text
"s"
    Maybe Addr
toAddr   <- Object -> Text -> Parser (Maybe Addr)
addrFieldMaybe Object
val Text
"to"
    W256
v        <- Object -> Text -> Parser W256
wordField Object
val Text
"v"
    W256
value    <- Object -> Text -> Parser W256
wordField Object
val Text
"value"
    Maybe Integer
txType   <- (String -> Integer) -> Maybe String -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Integer
forall a. Read a => String -> a
read (Maybe String -> Maybe Integer)
-> Parser (Maybe String) -> Parser (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
val Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
JSON..:? Text
"type")
    --let legacyTxn = Transaction tdata gasLimit gasPrice nonce r s toAddr v value
    case Maybe Integer
txType of
      Just Integer
0x00 -> Transaction -> Parser Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Transaction -> Parser Transaction)
-> Transaction -> Parser Transaction
forall a b. (a -> b) -> a -> b
$ ByteString
-> W256
-> W256
-> W256
-> W256
-> W256
-> Maybe Addr
-> W256
-> W256
-> TxType
-> [AccessListEntry]
-> Transaction
Transaction ByteString
tdata W256
gasLimit W256
gasPrice W256
nonce W256
r W256
s Maybe Addr
toAddr W256
v W256
value TxType
LegacyTransaction []
      Just Integer
0x01 -> do
        [AccessListEntry]
accessListEntries <- (Object
val Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
JSON..: Text
"accessList") Parser Value
-> (Value -> Parser [AccessListEntry]) -> Parser [AccessListEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser [AccessListEntry]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList
        Transaction -> Parser Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Transaction -> Parser Transaction)
-> Transaction -> Parser Transaction
forall a b. (a -> b) -> a -> b
$ ByteString
-> W256
-> W256
-> W256
-> W256
-> W256
-> Maybe Addr
-> W256
-> W256
-> TxType
-> [AccessListEntry]
-> Transaction
Transaction ByteString
tdata W256
gasLimit W256
gasPrice W256
nonce W256
r W256
s Maybe Addr
toAddr W256
v W256
value TxType
AccessListTransaction [AccessListEntry]
accessListEntries
      Just Integer
_ -> String -> Parser Transaction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unrecognized custom transaction type"
      Maybe Integer
Nothing -> Transaction -> Parser Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Transaction -> Parser Transaction)
-> Transaction -> Parser Transaction
forall a b. (a -> b) -> a -> b
$ ByteString
-> W256
-> W256
-> W256
-> W256
-> W256
-> Maybe Addr
-> W256
-> W256
-> TxType
-> [AccessListEntry]
-> Transaction
Transaction ByteString
tdata W256
gasLimit W256
gasPrice W256
nonce W256
r W256
s Maybe Addr
toAddr W256
v W256
value TxType
LegacyTransaction []
  parseJSON Value
invalid =
    String -> Value -> Parser Transaction
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"Transaction" Value
invalid

accountAt :: Addr -> Getter (Map Addr EVM.Contract) EVM.Contract
accountAt :: Addr -> Getter (Map Addr Contract) Contract
accountAt Addr
a = (Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
a) ((Maybe Contract -> f (Maybe Contract))
 -> Map Addr Contract -> f (Map Addr Contract))
-> ((Contract -> f Contract)
    -> Maybe Contract -> f (Maybe Contract))
-> (Contract -> f Contract)
-> Map Addr Contract
-> f (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Contract -> Contract)
-> (Contract -> f Contract) -> Maybe Contract -> f (Maybe Contract)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Maybe Contract -> Contract)
 -> (Contract -> f Contract)
 -> Maybe Contract
 -> f (Maybe Contract))
-> (Maybe Contract -> Contract)
-> (Contract -> f Contract)
-> Maybe Contract
-> f (Maybe Contract)
forall a b. (a -> b) -> a -> b
$ Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe Contract
newAccount)

touchAccount :: Addr -> Map Addr EVM.Contract -> Map Addr EVM.Contract
touchAccount :: Addr -> Map Addr Contract -> Map Addr Contract
touchAccount Addr
a = (Contract -> Contract -> Contract)
-> Addr -> Contract -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((Contract -> Contract -> Contract)
-> Contract -> Contract -> Contract
forall a b c. (a -> b -> c) -> b -> a -> c
flip Contract -> Contract -> Contract
forall a b. a -> b -> a
const) Addr
a Contract
newAccount

newAccount :: EVM.Contract
newAccount :: Contract
newAccount = ContractCode -> Contract
initialContract (ContractCode -> Contract) -> ContractCode -> Contract
forall a b. (a -> b) -> a -> b
$ Buffer -> ContractCode
EVM.RuntimeCode Buffer
forall a. Monoid a => a
mempty

-- | Increments origin nonce and pays gas deposit
setupTx :: Addr -> Addr -> Word -> Word -> Map Addr EVM.Contract -> Map Addr EVM.Contract
setupTx :: Addr
-> Addr -> Word -> Word -> Map Addr Contract -> Map Addr Contract
setupTx Addr
origin Addr
coinbase Word
gasPrice Word
gasLimit Map Addr Contract
prestate =
  let gasCost :: Word
gasCost = Word
gasPrice Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
gasLimit
  in ((Contract -> Contract)
-> Addr -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((ASetter Contract Contract Word Word
-> (Word -> Word) -> Contract -> Contract
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Contract Contract Word Word
Lens' Contract Word
EVM.nonce   (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1))
               (Contract -> Contract)
-> (Contract -> Contract) -> Contract -> Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASetter Contract Contract Word Word
-> (Word -> Word) -> Contract -> Contract
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Contract Contract Word Word
Lens' Contract Word
balance (Word -> Word -> Word
forall a. Num a => a -> a -> a
subtract Word
gasCost))) Addr
origin)
    (Map Addr Contract -> Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract
-> Map Addr Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Map Addr Contract -> Map Addr Contract
touchAccount Addr
origin
    (Map Addr Contract -> Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract
-> Map Addr Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Map Addr Contract -> Map Addr Contract
touchAccount Addr
coinbase (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract -> Map Addr Contract
forall a b. (a -> b) -> a -> b
$ Map Addr Contract
prestate

-- | Given a valid tx loaded into the vm state,
-- subtract gas payment from the origin, increment the nonce
-- and pay receiving address
initTx :: EVM.VM -> EVM.VM
initTx :: VM -> VM
initTx VM
vm = let
    toAddr :: Addr
toAddr   = Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
EVM.state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
    -> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
EVM.contract) VM
vm
    origin :: Addr
origin   = Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxState -> Const Addr TxState) -> VM -> Const Addr VM
Lens' VM TxState
EVM.tx ((TxState -> Const Addr TxState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr) -> TxState -> Const Addr TxState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> TxState -> Const Addr TxState
Lens' TxState Addr
EVM.origin) VM
vm
    gasPrice :: Word
gasPrice = Getting Word VM Word -> VM -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxState -> Const Word TxState) -> VM -> Const Word VM
Lens' VM TxState
EVM.tx ((TxState -> Const Word TxState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> TxState -> Const Word TxState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> TxState -> Const Word TxState
Lens' TxState Word
EVM.gasprice) VM
vm
    gasLimit :: Word
gasLimit = Getting Word VM Word -> VM -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxState -> Const Word TxState) -> VM -> Const Word VM
Lens' VM TxState
EVM.tx ((TxState -> Const Word TxState) -> VM -> Const Word VM)
-> ((Word -> Const Word Word) -> TxState -> Const Word TxState)
-> Getting Word VM Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> TxState -> Const Word TxState
Lens' TxState Word
EVM.txgaslimit) VM
vm
    coinbase :: Addr
coinbase = Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Block -> Const Addr Block) -> VM -> Const Addr VM
Lens' VM Block
EVM.block ((Block -> Const Addr Block) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr) -> Block -> Const Addr Block)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> Block -> Const Addr Block
Lens' Block Addr
EVM.coinbase) VM
vm
    value :: SymWord
value    = Getting SymWord VM SymWord -> VM -> SymWord
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const SymWord FrameState) -> VM -> Const SymWord VM
Lens' VM FrameState
EVM.state ((FrameState -> Const SymWord FrameState)
 -> VM -> Const SymWord VM)
-> ((SymWord -> Const SymWord SymWord)
    -> FrameState -> Const SymWord FrameState)
-> Getting SymWord VM SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymWord -> Const SymWord SymWord)
-> FrameState -> Const SymWord FrameState
Lens' FrameState SymWord
EVM.callvalue) VM
vm
    toContract :: Contract
toContract = ContractCode -> Contract
initialContract (Buffer -> ContractCode
EVM.InitCode (Getting Buffer VM Buffer -> VM -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM
Lens' VM FrameState
EVM.state ((FrameState -> Const Buffer FrameState) -> VM -> Const Buffer VM)
-> ((Buffer -> Const Buffer Buffer)
    -> FrameState -> Const Buffer FrameState)
-> Getting Buffer VM Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Const Buffer Buffer)
-> FrameState -> Const Buffer FrameState
Lens' FrameState Buffer
EVM.code) VM
vm))
    preState :: Map Addr Contract
preState = Addr
-> Addr -> Word -> Word -> Map Addr Contract -> Map Addr Contract
setupTx Addr
origin Addr
coinbase Word
gasPrice Word
gasLimit (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract -> Map Addr Contract
forall a b. (a -> b) -> a -> b
$ Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
EVM.env ((Env -> Const (Map Addr Contract) Env)
 -> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
 -> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
EVM.contracts) VM
vm
    oldBalance :: Word
oldBalance = Getting Word (Map Addr Contract) Word -> Map Addr Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Addr -> Getter (Map Addr Contract) Contract
accountAt Addr
toAddr ((Contract -> Const Word Contract)
 -> Map Addr Contract -> Const Word (Map Addr Contract))
-> ((Word -> Const Word Word) -> Contract -> Const Word Contract)
-> Getting Word (Map Addr Contract) Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Const Word Word) -> Contract -> Const Word Contract
Lens' Contract Word
balance) Map Addr Contract
preState
    creation :: Bool
creation = Getting Bool VM Bool -> VM -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((TxState -> Const Bool TxState) -> VM -> Const Bool VM
Lens' VM TxState
EVM.tx ((TxState -> Const Bool TxState) -> VM -> Const Bool VM)
-> ((Bool -> Const Bool Bool) -> TxState -> Const Bool TxState)
-> Getting Bool VM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> TxState -> Const Bool TxState
Lens' TxState Bool
EVM.isCreate) VM
vm
    initState :: Map Addr Contract
initState =
      (if Maybe Word -> Bool
forall a. Maybe a -> Bool
isJust (SymWord -> Maybe Word
maybeLitWord SymWord
value)
       then ((Contract -> Contract)
-> Addr -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ASetter Contract Contract Word Word
-> (Word -> Word) -> Contract -> Contract
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Contract Contract Word Word
Lens' Contract Word
balance (Word -> Word -> Word
forall a. Num a => a -> a -> a
subtract (SymWord -> Word
forceLit SymWord
value))) Addr
origin)
        (Map Addr Contract -> Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract
-> Map Addr Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Contract -> Contract)
-> Addr -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (ASetter Contract Contract Word Word
-> (Word -> Word) -> Contract -> Contract
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Contract Contract Word Word
Lens' Contract Word
balance (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ (SymWord -> Word
forceLit SymWord
value))) Addr
toAddr)
       else Map Addr Contract -> Map Addr Contract
forall a. a -> a
id)
      (Map Addr Contract -> Map Addr Contract)
-> (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract
-> Map Addr Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
creation
         then Addr -> Contract -> Map Addr Contract -> Map Addr Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Addr
toAddr (Contract
toContract Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Word Word
Lens' Contract Word
balance ASetter Contract Contract Word Word -> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word
oldBalance)
         else Addr -> Map Addr Contract -> Map Addr Contract
touchAccount Addr
toAddr)
      (Map Addr Contract -> Map Addr Contract)
-> Map Addr Contract -> Map Addr Contract
forall a b. (a -> b) -> a -> b
$ Map Addr Contract
preState

    in
      VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& (Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
EVM.env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> Env -> Identity Env)
-> (Map Addr Contract -> Identity (Map Addr Contract))
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
EVM.contracts ((Map Addr Contract -> Identity (Map Addr Contract))
 -> VM -> Identity VM)
-> Map Addr Contract -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Addr Contract
initState
         VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& (TxState -> Identity TxState) -> VM -> Identity VM
Lens' VM TxState
EVM.tx ((TxState -> Identity TxState) -> VM -> Identity VM)
-> ((Map Addr Contract -> Identity (Map Addr Contract))
    -> TxState -> Identity TxState)
-> (Map Addr Contract -> Identity (Map Addr Contract))
-> VM
-> Identity VM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> TxState -> Identity TxState
Lens' TxState (Map Addr Contract)
EVM.txReversion ((Map Addr Contract -> Identity (Map Addr Contract))
 -> VM -> Identity VM)
-> Map Addr Contract -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Addr Contract
preState