{-# Language CPP #-}
{-# Language TemplateHaskell #-}

module EVM.VMTest
  ( Case
  , BlockchainCase
#if MIN_VERSION_aeson(1, 0, 0)
  , parseBCSuite
#endif
  , initTx
  , setupTx
  , vmForCase
  , checkExpectation
  ) where

import Prelude hiding (Word)

import qualified EVM
import EVM (contractcode, storage, origStorage, balance, nonce, Storage(..), initialContract)
import qualified EVM.Concrete as EVM
import qualified EVM.FeeSchedule

import EVM.Symbolic
import EVM.Transaction
import EVM.Types

import Control.Arrow ((***), (&&&))
import Control.Lens
import Control.Monad

import GHC.Stack

import Data.Aeson ((.:), (.:?), FromJSON (..))
import Data.Foldable (fold)
import Data.Map (Map)
import Data.Maybe (fromMaybe, isNothing)
import Data.Witherable (Filterable, catMaybes)

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

data Which = Pre | Post

data Block = Block
  { Block -> Addr
blockCoinbase    :: Addr
  , Block -> W256
blockDifficulty  :: W256
  , Block -> W256
blockGasLimit    :: W256
  , Block -> W256
blockBaseFee     :: W256
  , Block -> W256
blockNumber      :: W256
  , Block -> W256
blockTimestamp   :: W256
  , Block -> [Transaction]
blockTxs         :: [Transaction]
  } deriving Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show

data Case = Case
  { Case -> VMOpts
testVmOpts      :: EVM.VMOpts
  , Case -> Map Addr Contract
checkContracts  :: Map Addr EVM.Contract
  , Case -> Map Addr Contract
testExpectation :: Map Addr EVM.Contract
  } deriving Int -> Case -> ShowS
[Case] -> ShowS
Case -> String
(Int -> Case -> ShowS)
-> (Case -> String) -> ([Case] -> ShowS) -> Show Case
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Case] -> ShowS
$cshowList :: [Case] -> ShowS
show :: Case -> String
$cshow :: Case -> String
showsPrec :: Int -> Case -> ShowS
$cshowsPrec :: Int -> Case -> ShowS
Show

data BlockchainCase = BlockchainCase
  { BlockchainCase -> [Block]
blockchainBlocks  :: [Block]
  , BlockchainCase -> Map Addr Contract
blockchainPre     :: Map Addr EVM.Contract
  , BlockchainCase -> Map Addr Contract
blockchainPost    :: Map Addr EVM.Contract
  , BlockchainCase -> String
blockchainNetwork :: String
  } deriving Int -> BlockchainCase -> ShowS
[BlockchainCase] -> ShowS
BlockchainCase -> String
(Int -> BlockchainCase -> ShowS)
-> (BlockchainCase -> String)
-> ([BlockchainCase] -> ShowS)
-> Show BlockchainCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockchainCase] -> ShowS
$cshowList :: [BlockchainCase] -> ShowS
show :: BlockchainCase -> String
$cshow :: BlockchainCase -> String
showsPrec :: Int -> BlockchainCase -> ShowS
$cshowsPrec :: Int -> BlockchainCase -> ShowS
Show

splitEithers :: (Filterable f) => f (Either a b) -> (f a, f b)
splitEithers :: f (Either a b) -> (f a, f b)
splitEithers =
  (f (Maybe a) -> f a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (f (Maybe a) -> f a)
-> (f (Maybe b) -> f b) -> (f (Maybe a), f (Maybe b)) -> (f a, f b)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** f (Maybe b) -> f b
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes)
  ((f (Maybe a), f (Maybe b)) -> (f a, f b))
-> (f (Either a b) -> (f (Maybe a), f (Maybe b)))
-> f (Either a b)
-> (f a, f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Maybe a, Maybe b) -> Maybe a)
-> f (Maybe a, Maybe b) -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a, Maybe b) -> Maybe a
forall a b. (a, b) -> a
fst (f (Maybe a, Maybe b) -> f (Maybe a))
-> (f (Maybe a, Maybe b) -> f (Maybe b))
-> f (Maybe a, Maybe b)
-> (f (Maybe a), f (Maybe b))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Maybe a, Maybe b) -> Maybe b)
-> f (Maybe a, Maybe b) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe a, Maybe b) -> Maybe b
forall a b. (a, b) -> b
snd)
  (f (Maybe a, Maybe b) -> (f (Maybe a), f (Maybe b)))
-> (f (Either a b) -> f (Maybe a, Maybe b))
-> f (Either a b)
-> (f (Maybe a), f (Maybe b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either a b -> (Maybe a, Maybe b))
-> f (Either a b) -> f (Maybe a, Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (First a) (Either a b) a -> Either a b -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) (Either a b) a
forall a c b. Prism (Either a c) (Either b c) a b
_Left (Either a b -> Maybe a)
-> (Either a b -> Maybe b) -> Either a b -> (Maybe a, Maybe b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (First b) (Either a b) b -> Either a b -> Maybe b
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First b) (Either a b) b
forall c a b. Prism (Either c a) (Either c b) a b
_Right))

checkStateFail :: Bool -> Case -> EVM.VM -> (Bool, Bool, Bool, Bool, Bool) -> IO Bool
checkStateFail :: Bool -> Case -> VM -> (Bool, Bool, Bool, Bool, Bool) -> IO Bool
checkStateFail Bool
diff Case
x VM
vm (Bool
okState, Bool
okMoney, Bool
okNonce, Bool
okData, Bool
okCode) = do
  let
    printContracts :: Map Addr EVM.Contract -> IO ()
    printContracts :: Map Addr Contract -> IO ()
printContracts Map Addr Contract
cs = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (Addr -> Contract -> ShowS)
-> String -> Map Addr Contract -> String
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\Addr
k Contract
v String
acc ->
      String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Addr -> String
forall a. Show a => a -> String
show Addr
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : "
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (Word -> Integer) -> Word -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger  (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
v)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (Word -> Integer) -> Word -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger  (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
v)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Storage -> String
printStorage (Storage -> String) -> Storage -> String
forall a b. (a -> b) -> a -> b
$ (Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
v))
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") String
"" Map Addr Contract
cs

    reason :: [String]
reason = ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst (((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, Bool) -> Bool) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> Bool
forall a b. (a, b) -> b
snd)
        [ (String
"bad-state",       Bool
okMoney Bool -> Bool -> Bool
|| Bool
okNonce Bool -> Bool -> Bool
|| Bool
okData  Bool -> Bool -> Bool
|| Bool
okCode Bool -> Bool -> Bool
|| Bool
okState)
        , (String
"bad-balance", Bool -> Bool
not Bool
okMoney Bool -> Bool -> Bool
|| Bool
okNonce Bool -> Bool -> Bool
|| Bool
okData  Bool -> Bool -> Bool
|| Bool
okCode Bool -> Bool -> Bool
|| Bool
okState)
        , (String
"bad-nonce",   Bool -> Bool
not Bool
okNonce Bool -> Bool -> Bool
|| Bool
okMoney Bool -> Bool -> Bool
|| Bool
okData  Bool -> Bool -> Bool
|| Bool
okCode Bool -> Bool -> Bool
|| Bool
okState)
        , (String
"bad-storage", Bool -> Bool
not Bool
okData  Bool -> Bool -> Bool
|| Bool
okMoney Bool -> Bool -> Bool
|| Bool
okNonce Bool -> Bool -> Bool
|| Bool
okCode Bool -> Bool -> Bool
|| Bool
okState)
        , (String
"bad-code",    Bool -> Bool
not Bool
okCode  Bool -> Bool -> Bool
|| Bool
okMoney Bool -> Bool -> Bool
|| Bool
okNonce Bool -> Bool -> Bool
|| Bool
okData Bool -> Bool -> Bool
|| Bool
okState)
        ])
    check :: Map Addr Contract
check = Case -> Map Addr Contract
checkContracts Case
x
    expected :: Map Addr Contract
expected = Case -> Map Addr Contract
testExpectation Case
x
    actual :: Map Addr Contract
actual = 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 ((Map Addr Contract
  -> Const (Map Addr Contract) (Map Addr Contract))
 -> Env -> Const (Map Addr Contract) Env)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> (Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> Env
-> Const (Map Addr Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Map Addr Contract)
-> (Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> Map Addr Contract
-> Const (Map Addr Contract) (Map Addr Contract)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Contract -> Contract
clearZeroStorage(Contract -> Contract)
-> (Contract -> Contract) -> Contract -> Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Contract -> Contract
clearOrigStorage))) VM
vm
    printStorage :: Storage -> String
printStorage (EVM.Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
c) = SArray (WordN 256) (WordN 256) -> String
forall a. Show a => a -> String
show SArray (WordN 256) (WordN 256)
c
    printStorage (EVM.Concrete Map Word SymWord
c) = [(Word, SymWord)] -> String
forall a. Show a => a -> String
show ([(Word, SymWord)] -> String) -> [(Word, SymWord)] -> String
forall a b. (a -> b) -> a -> b
$ Map Word SymWord -> [(Word, SymWord)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Word SymWord
c

  String -> IO ()
putStr ([String] -> String
unwords [String]
reason)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
diff Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
okState)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"\nPre balance/state: "
    Map Addr Contract -> IO ()
printContracts Map Addr Contract
check
    String -> IO ()
putStrLn String
"\nExpected balance/state: "
    Map Addr Contract -> IO ()
printContracts Map Addr Contract
expected
    String -> IO ()
putStrLn String
"\nActual balance/state: "
    Map Addr Contract -> IO ()
printContracts Map Addr Contract
actual
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
okState

checkExpectation :: HasCallStack => Bool -> Case -> EVM.VM -> IO Bool
checkExpectation :: Bool -> Case -> VM -> IO Bool
checkExpectation Bool
diff Case
x VM
vm = do
  let expectation :: Map Addr Contract
expectation = Case -> Map Addr Contract
testExpectation Case
x
      (Bool
okState, Bool
b2, Bool
b3, Bool
b4, Bool
b5) = HasCallStack =>
VM -> Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool)
VM -> Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool)
checkExpectedContracts VM
vm (Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool))
-> Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool)
forall a b. (a -> b) -> a -> b
$ Map Addr Contract
expectation
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
okState (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Case -> VM -> (Bool, Bool, Bool, Bool, Bool) -> IO Bool
checkStateFail
    Bool
diff Case
x VM
vm (Bool
okState, Bool
b2, Bool
b3, Bool
b4, Bool
b5)
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
okState

-- quotient account state by nullness
(~=) :: Map Addr EVM.Contract -> Map Addr EVM.Contract -> Bool
~= :: Map Addr Contract -> Map Addr Contract -> Bool
(~=) Map Addr Contract
cs Map Addr Contract
cs' =
    let nullAccount :: Contract
nullAccount = ContractCode -> Contract
EVM.initialContract (Buffer -> ContractCode
EVM.RuntimeCode Buffer
forall a. Monoid a => a
mempty)
        padNewAccounts :: Map k Contract -> [k] -> Map k Contract
padNewAccounts Map k Contract
cs'' [k]
ks = ([Map k Contract -> Map k Contract]
-> Map k Contract -> Map k Contract
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [(Contract -> Contract -> Contract)
-> k -> Contract -> Map k Contract -> Map k Contract
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\Contract
_ Contract
x -> Contract
x) k
k Contract
nullAccount | k
k <- [k]
ks]) Map k Contract
cs''
        padded_cs' :: Map Addr Contract
padded_cs' = Map Addr Contract -> [Addr] -> Map Addr Contract
forall k. Ord k => Map k Contract -> [k] -> Map k Contract
padNewAccounts Map Addr Contract
cs' (Map Addr Contract -> [Addr]
forall k a. Map k a -> [k]
Map.keys Map Addr Contract
cs)
        padded_cs :: Map Addr Contract
padded_cs  = Map Addr Contract -> [Addr] -> Map Addr Contract
forall k. Ord k => Map k Contract -> [k] -> Map k Contract
padNewAccounts Map Addr Contract
cs  (Map Addr Contract -> [Addr]
forall k a. Map k a -> [k]
Map.keys Map Addr Contract
cs')
    in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Contract -> Contract -> Bool)
-> [Contract] -> [Contract] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Contract -> Contract -> Bool
(===) (Map Addr Contract -> [Contract]
forall k a. Map k a -> [a]
Map.elems Map Addr Contract
padded_cs) (Map Addr Contract -> [Contract]
forall k a. Map k a -> [a]
Map.elems Map Addr Contract
padded_cs')

(===) :: EVM.Contract -> EVM.Contract -> Bool
Contract
a === :: Contract -> Contract -> Bool
=== Contract
b = Bool
codeEqual Bool -> Bool -> Bool
&& Bool
storageEqual Bool -> Bool -> Bool
&& (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
a Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance Contract
b) Bool -> Bool -> Bool
&& (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
a Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce Contract
b)
  where
    storageEqual :: Bool
storageEqual = Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
a Storage -> Storage -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
b
    codeEqual :: Bool
codeEqual = case (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
a, Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
b) of
      (EVM.RuntimeCode (ConcreteBuffer ByteString
a'), EVM.RuntimeCode (ConcreteBuffer ByteString
b')) -> ByteString
a' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b'
      (ContractCode, ContractCode)
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"unexpected code"

checkExpectedContracts :: HasCallStack => EVM.VM -> Map Addr EVM.Contract -> (Bool, Bool, Bool, Bool, Bool)
checkExpectedContracts :: VM -> Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool)
checkExpectedContracts VM
vm Map Addr Contract
expected =
  let cs :: Map Addr Contract
cs = VM
vm VM
-> Getting (Map Addr Contract) VM (Map Addr Contract)
-> Map Addr Contract
forall s a. s -> Getting a s a -> a
^. (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 ((Map Addr Contract
  -> Const (Map Addr Contract) (Map Addr Contract))
 -> Env -> Const (Map Addr Contract) Env)
-> ((Map Addr Contract
     -> Const (Map Addr Contract) (Map Addr Contract))
    -> Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> (Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> Env
-> Const (Map Addr Contract) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Map Addr Contract)
-> (Map Addr Contract
    -> Const (Map Addr Contract) (Map Addr Contract))
-> Map Addr Contract
-> Const (Map Addr Contract) (Map Addr Contract)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Contract -> Contract
clearZeroStorage(Contract -> Contract)
-> (Contract -> Contract) -> Contract -> Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Contract -> Contract
clearOrigStorage))
      expectedCs :: Map Addr Contract
expectedCs = Contract -> Contract
clearOrigStorage (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
expected
  in ( (Map Addr Contract
expectedCs Map Addr Contract -> Map Addr Contract -> Bool
~= Map Addr Contract
cs)
     , (Contract -> Contract
clearBalance (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
expectedCs) Map Addr Contract -> Map Addr Contract -> Bool
~= (Contract -> Contract
clearBalance (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
cs)
     , (Contract -> Contract
clearNonce   (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
expectedCs) Map Addr Contract -> Map Addr Contract -> Bool
~= (Contract -> Contract
clearNonce   (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
cs)
     , (Contract -> Contract
clearStorage (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
expectedCs) Map Addr Contract -> Map Addr Contract -> Bool
~= (Contract -> Contract
clearStorage (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
cs)
     , (Contract -> Contract
clearCode    (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
expectedCs) Map Addr Contract -> Map Addr Contract -> Bool
~= (Contract -> Contract
clearCode    (Contract -> Contract) -> Map Addr Contract -> Map Addr Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Addr Contract
cs)
     )

clearOrigStorage :: EVM.Contract -> EVM.Contract
clearOrigStorage :: Contract -> Contract
clearOrigStorage = ASetter Contract Contract (Map Word Word) (Map Word Word)
-> Map Word Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract (Map Word Word) (Map Word Word)
Lens' Contract (Map Word Word)
origStorage Map Word Word
forall a. Monoid a => a
mempty

clearZeroStorage :: EVM.Contract -> EVM.Contract
clearZeroStorage :: Contract -> Contract
clearZeroStorage Contract
c = case Getting Storage Contract Storage -> Contract -> Storage
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Storage Contract Storage
Lens' Contract Storage
storage Contract
c of
  EVM.Symbolic [(SymWord, SymWord)]
_ SArray (WordN 256) (WordN 256)
_ -> Contract
c
  EVM.Concrete Map Word SymWord
m -> let store :: Map Word SymWord
store = (SymWord -> Bool) -> Map Word SymWord -> Map Word SymWord
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\SymWord
x -> SymWord -> Word
forceLit SymWord
x Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0) Map Word SymWord
m
                    in ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Storage Storage
Lens' Contract Storage
EVM.storage (Map Word SymWord -> Storage
EVM.Concrete Map Word SymWord
store) Contract
c

clearStorage :: EVM.Contract -> EVM.Contract
clearStorage :: Contract -> Contract
clearStorage = ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage (Map Word SymWord -> Storage
EVM.Concrete Map Word SymWord
forall a. Monoid a => a
mempty)

clearBalance :: EVM.Contract -> EVM.Contract
clearBalance :: Contract -> Contract
clearBalance = ASetter Contract Contract Word Word -> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Word Word
Lens' Contract Word
balance Word
0

clearNonce :: EVM.Contract -> EVM.Contract
clearNonce :: Contract -> Contract
clearNonce = ASetter Contract Contract Word Word -> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract Word Word
Lens' Contract Word
nonce Word
0

clearCode :: EVM.Contract -> EVM.Contract
clearCode :: Contract -> Contract
clearCode = ASetter Contract Contract ContractCode ContractCode
-> ContractCode -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Contract Contract ContractCode ContractCode
Lens' Contract ContractCode
contractcode (Buffer -> ContractCode
EVM.RuntimeCode Buffer
forall a. Monoid a => a
mempty)

#if MIN_VERSION_aeson(1, 0, 0)

instance FromJSON EVM.Contract where
  parseJSON :: Value -> Parser Contract
parseJSON (JSON.Object Object
v) = do
    ContractCode
code <- (Buffer -> ContractCode
EVM.RuntimeCode (Buffer -> ContractCode)
-> (ByteString -> Buffer) -> ByteString -> ContractCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Buffer
ConcreteBuffer (ByteString -> ContractCode)
-> Parser ByteString -> Parser ContractCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ByteString
hexText (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"code"))
    Map Word W256
storage' <- (W256 -> Word) -> Map W256 W256 -> Map Word W256
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys W256 -> Word
w256 (Map W256 W256 -> Map Word W256)
-> Parser (Map W256 W256) -> Parser (Map Word W256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Map W256 W256)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"storage"
    W256
balance' <- Object
v Object -> Text -> Parser W256
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"balance"
    W256
nonce'   <- Object
v Object -> Text -> Parser W256
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"nonce"
    Contract -> Parser Contract
forall (m :: * -> *) a. Monad m => a -> m a
return
      (Contract -> Parser Contract) -> Contract -> Parser Contract
forall a b. (a -> b) -> a -> b
$
      ContractCode -> Contract
EVM.initialContract ContractCode
code
       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
.~ W256 -> Word
w256 W256
balance'
       Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Word Word
Lens' Contract Word
nonce   ASetter Contract Contract Word Word -> Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
.~ W256 -> Word
w256 W256
nonce'
       Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract Storage Storage
Lens' Contract Storage
storage ASetter Contract Contract Storage Storage
-> Storage -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Word SymWord -> Storage
EVM.Concrete ((W256 -> SymWord) -> Map Word W256 -> Map Word SymWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> SymWord
litWord (Word -> SymWord) -> (W256 -> Word) -> W256 -> SymWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> Word
w256) Map Word W256
storage')
       Contract -> (Contract -> Contract) -> Contract
forall a b. a -> (a -> b) -> b
& ASetter Contract Contract (Map Word Word) (Map Word Word)
Lens' Contract (Map Word Word)
origStorage ASetter Contract Contract (Map Word Word) (Map Word Word)
-> Map Word Word -> Contract -> Contract
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (W256 -> Word) -> Map Word W256 -> Map Word Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap W256 -> Word
w256 Map Word W256
storage'

  parseJSON Value
invalid =
    String -> Value -> Parser Contract
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"Contract" Value
invalid

instance FromJSON BlockchainCase where
  parseJSON :: Value -> Parser BlockchainCase
parseJSON (JSON.Object Object
v) = [Block]
-> Map Addr Contract
-> Map Addr Contract
-> String
-> BlockchainCase
BlockchainCase
    ([Block]
 -> Map Addr Contract
 -> Map Addr Contract
 -> String
 -> BlockchainCase)
-> Parser [Block]
-> Parser
     (Map Addr Contract
      -> Map Addr Contract -> String -> BlockchainCase)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Block]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"blocks"
    Parser
  (Map Addr Contract
   -> Map Addr Contract -> String -> BlockchainCase)
-> Parser (Map Addr Contract)
-> Parser (Map Addr Contract -> String -> BlockchainCase)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Which -> Object -> Parser (Map Addr Contract)
parseContracts Which
Pre Object
v
    Parser (Map Addr Contract -> String -> BlockchainCase)
-> Parser (Map Addr Contract) -> Parser (String -> BlockchainCase)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Which -> Object -> Parser (Map Addr Contract)
parseContracts Which
Post Object
v
    Parser (String -> BlockchainCase)
-> Parser String -> Parser BlockchainCase
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"network"
  parseJSON Value
invalid =
    String -> Value -> Parser BlockchainCase
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"GeneralState test case" Value
invalid

instance FromJSON Block where
  parseJSON :: Value -> Parser Block
parseJSON (JSON.Object Object
v) = do
    Object
v'         <- Object
v Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"blockHeader"
    [Transaction]
txs        <- Object
v Object -> Text -> Parser [Transaction]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"transactions"
    Addr
coinbase   <- Object -> Text -> Parser Addr
addrField Object
v' Text
"coinbase"
    W256
difficulty <- Object -> Text -> Parser W256
wordField Object
v' Text
"difficulty"
    W256
gasLimit   <- Object -> Text -> Parser W256
wordField Object
v' Text
"gasLimit"
    W256
number     <- Object -> Text -> Parser W256
wordField Object
v' Text
"number"
    Maybe W256
baseFee    <- (String -> W256) -> Maybe String -> Maybe W256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> W256
forall a. Read a => String -> a
read (Maybe String -> Maybe W256)
-> Parser (Maybe String) -> Parser (Maybe W256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v' Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"baseFeePerGas"
    W256
timestamp  <- Object -> Text -> Parser W256
wordField Object
v' Text
"timestamp"
    Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Parser Block) -> Block -> Parser Block
forall a b. (a -> b) -> a -> b
$ Addr
-> W256 -> W256 -> W256 -> W256 -> W256 -> [Transaction] -> Block
Block Addr
coinbase W256
difficulty W256
gasLimit (W256 -> Maybe W256 -> W256
forall a. a -> Maybe a -> a
fromMaybe W256
0 Maybe W256
baseFee) W256
number W256
timestamp [Transaction]
txs
  parseJSON Value
invalid =
    String -> Value -> Parser Block
forall a. String -> Value -> Parser a
JSON.typeMismatch String
"Block" Value
invalid

parseContracts ::
  Which -> JSON.Object -> JSON.Parser (Map Addr EVM.Contract)
parseContracts :: Which -> Object -> Parser (Map Addr Contract)
parseContracts Which
w Object
v =
  Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
which Parser Value
-> (Value -> Parser (Map Addr Contract))
-> Parser (Map Addr Contract)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser (Map Addr Contract)
forall a. FromJSON a => Value -> Parser a
parseJSON
  where which :: Text
which = case Which
w of
          Which
Pre  -> Text
"pre"
          Which
Post -> Text
"postState"

parseBCSuite ::
  Lazy.ByteString -> Either String (Map String Case)
parseBCSuite :: ByteString -> Either String (Map String Case)
parseBCSuite ByteString
x = case (ByteString -> Either String (Map String BlockchainCase)
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode' ByteString
x) :: Either String (Map String BlockchainCase) of
  Left String
e        -> String -> Either String (Map String Case)
forall a b. a -> Either a b
Left String
e
  Right Map String BlockchainCase
bcCases -> let allCases :: Map String (Either BlockchainError Case)
allCases = BlockchainCase -> Either BlockchainError Case
fromBlockchainCase (BlockchainCase -> Either BlockchainError Case)
-> Map String BlockchainCase
-> Map String (Either BlockchainError Case)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String BlockchainCase
bcCases
                       keepError :: Either BlockchainError b -> Bool
keepError (Left BlockchainError
e) = BlockchainError -> Bool
errorFatal BlockchainError
e
                       keepError Either BlockchainError b
_        = Bool
True
                       filteredCases :: Map String (Either BlockchainError Case)
filteredCases = (Either BlockchainError Case -> Bool)
-> Map String (Either BlockchainError Case)
-> Map String (Either BlockchainError Case)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Either BlockchainError Case -> Bool
forall b. Either BlockchainError b -> Bool
keepError Map String (Either BlockchainError Case)
allCases
                       (Map String BlockchainError
erroredCases, Map String Case
parsedCases) = Map String (Either BlockchainError Case)
-> (Map String BlockchainError, Map String Case)
forall (f :: * -> *) a b.
Filterable f =>
f (Either a b) -> (f a, f b)
splitEithers Map String (Either BlockchainError Case)
filteredCases
    in if Map String BlockchainError -> Int
forall k a. Map k a -> Int
Map.size Map String BlockchainError
erroredCases Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then String -> Either String (Map String Case)
forall a b. a -> Either a b
Left (String
"errored case: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Map String BlockchainError -> String
forall a. Show a => a -> String
show Map String BlockchainError
erroredCases))
    else if Map String Case -> Int
forall k a. Map k a -> Int
Map.size Map String Case
parsedCases Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then String -> Either String (Map String Case)
forall a b. a -> Either a b
Left String
"No cases to check."
    else Map String Case -> Either String (Map String Case)
forall a b. b -> Either a b
Right Map String Case
parsedCases
#endif

data BlockchainError
  = TooManyBlocks
  | TooManyTxs
  | NoTxs
  | SignatureUnverified
  | InvalidTx
  | OldNetwork
  | FailedCreate
  deriving Int -> BlockchainError -> ShowS
[BlockchainError] -> ShowS
BlockchainError -> String
(Int -> BlockchainError -> ShowS)
-> (BlockchainError -> String)
-> ([BlockchainError] -> ShowS)
-> Show BlockchainError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockchainError] -> ShowS
$cshowList :: [BlockchainError] -> ShowS
show :: BlockchainError -> String
$cshow :: BlockchainError -> String
showsPrec :: Int -> BlockchainError -> ShowS
$cshowsPrec :: Int -> BlockchainError -> ShowS
Show

errorFatal :: BlockchainError -> Bool
errorFatal :: BlockchainError -> Bool
errorFatal BlockchainError
TooManyBlocks = Bool
True
errorFatal BlockchainError
TooManyTxs = Bool
True
errorFatal BlockchainError
SignatureUnverified = Bool
True
errorFatal BlockchainError
InvalidTx = Bool
True
errorFatal BlockchainError
_ = Bool
False

fromBlockchainCase :: BlockchainCase -> Either BlockchainError Case
fromBlockchainCase :: BlockchainCase -> Either BlockchainError Case
fromBlockchainCase (BlockchainCase [Block]
blocks Map Addr Contract
preState Map Addr Contract
postState String
network) =
  case ([Block]
blocks, String
network) of
    ([Block
block], String
"London") -> case Block -> [Transaction]
blockTxs Block
block of
      [Transaction
tx] -> Block
-> Transaction
-> Map Addr Contract
-> Map Addr Contract
-> Either BlockchainError Case
fromBlockchainCase' Block
block Transaction
tx Map Addr Contract
preState Map Addr Contract
postState
      []        -> BlockchainError -> Either BlockchainError Case
forall a b. a -> Either a b
Left BlockchainError
NoTxs
      [Transaction]
_         -> BlockchainError -> Either BlockchainError Case
forall a b. a -> Either a b
Left BlockchainError
TooManyTxs
    ([Block
_], String
_) -> BlockchainError -> Either BlockchainError Case
forall a b. a -> Either a b
Left BlockchainError
OldNetwork
    ([Block]
_, String
_)   -> BlockchainError -> Either BlockchainError Case
forall a b. a -> Either a b
Left BlockchainError
TooManyBlocks

fromBlockchainCase' :: Block -> Transaction
                       -> Map Addr EVM.Contract -> Map Addr EVM.Contract
                       -> Either BlockchainError Case
fromBlockchainCase' :: Block
-> Transaction
-> Map Addr Contract
-> Map Addr Contract
-> Either BlockchainError Case
fromBlockchainCase' Block
block Transaction
tx Map Addr Contract
preState Map Addr Contract
postState =
  let isCreate :: Bool
isCreate = Maybe Addr -> Bool
forall a. Maybe a -> Bool
isNothing (Transaction -> Maybe Addr
txToAddr Transaction
tx) in
  case (Int -> Transaction -> Maybe Addr
sender Int
1 Transaction
tx, Transaction
-> Block -> Map Addr Contract -> Maybe (Map Addr Contract)
checkTx Transaction
tx Block
block Map Addr Contract
preState) of
      (Maybe Addr
Nothing, Maybe (Map Addr Contract)
_) -> BlockchainError -> Either BlockchainError Case
forall a b. a -> Either a b
Left BlockchainError
SignatureUnverified
      (Maybe Addr
_, Maybe (Map Addr Contract)
Nothing) -> BlockchainError -> Either BlockchainError Case
forall a b. a -> Either a b
Left (if Bool
isCreate then BlockchainError
FailedCreate else BlockchainError
InvalidTx)
      (Just Addr
origin, Just Map Addr Contract
checkState) -> Case -> Either BlockchainError Case
forall a b. b -> Either a b
Right (Case -> Either BlockchainError Case)
-> Case -> Either BlockchainError Case
forall a b. (a -> b) -> a -> b
$ VMOpts -> Map Addr Contract -> Map Addr Contract -> Case
Case
        (VMOpts :: Contract
-> (Buffer, SymWord)
-> SymWord
-> W256
-> Addr
-> SAddr
-> Addr
-> W256
-> W256
-> W256
-> SymWord
-> Addr
-> W256
-> W256
-> W256
-> W256
-> W256
-> FeeSchedule Integer
-> W256
-> Bool
-> StorageModel
-> Map Addr [W256]
-> Bool
-> VMOpts
EVM.VMOpts
         { vmoptContract :: Contract
vmoptContract      = ContractCode -> Contract
EVM.initialContract ContractCode
theCode
         , vmoptCalldata :: (Buffer, SymWord)
vmoptCalldata      = (Buffer, SymWord)
cd
         , vmoptValue :: SymWord
vmoptValue         = Word -> SymWord
litWord (W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ Transaction -> W256
txValue Transaction
tx)
         , vmoptAddress :: Addr
vmoptAddress       = Addr
toAddr
         , vmoptCaller :: SAddr
vmoptCaller        = Addr -> SAddr
litAddr Addr
origin
         , vmoptOrigin :: Addr
vmoptOrigin        = Addr
origin
         , vmoptGas :: W256
vmoptGas           = Transaction -> W256
txGasLimit Transaction
tx W256 -> W256 -> W256
forall a. Num a => a -> a -> a
- Integer -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FeeSchedule Integer -> Transaction -> Integer
txGasCost FeeSchedule Integer
feeSchedule Transaction
tx)
         , vmoptBaseFee :: W256
vmoptBaseFee       = Block -> W256
blockBaseFee Block
block
         , vmoptPriorityFee :: W256
vmoptPriorityFee   = Transaction -> W256 -> W256
priorityFee Transaction
tx (Block -> W256
blockBaseFee Block
block)
         , vmoptGaslimit :: W256
vmoptGaslimit      = Transaction -> W256
txGasLimit Transaction
tx
         , vmoptNumber :: W256
vmoptNumber        = Block -> W256
blockNumber Block
block
         , vmoptTimestamp :: SymWord
vmoptTimestamp     = Word -> SymWord
litWord (Word -> SymWord) -> Word -> SymWord
forall a b. (a -> b) -> a -> b
$ W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ Block -> W256
blockTimestamp Block
block
         , vmoptCoinbase :: Addr
vmoptCoinbase      = Block -> Addr
blockCoinbase Block
block
         , vmoptDifficulty :: W256
vmoptDifficulty    = Block -> W256
blockDifficulty Block
block
         , vmoptMaxCodeSize :: W256
vmoptMaxCodeSize   = W256
24576
         , vmoptBlockGaslimit :: W256
vmoptBlockGaslimit = Block -> W256
blockGasLimit Block
block
         , vmoptGasprice :: W256
vmoptGasprice      = W256
effectiveGasPrice
         , vmoptSchedule :: FeeSchedule Integer
vmoptSchedule      = FeeSchedule Integer
feeSchedule
         , vmoptChainId :: W256
vmoptChainId       = W256
1
         , vmoptCreate :: Bool
vmoptCreate        = Bool
isCreate
         , vmoptStorageModel :: StorageModel
vmoptStorageModel  = StorageModel
EVM.ConcreteS
         , vmoptTxAccessList :: Map Addr [W256]
vmoptTxAccessList  = Transaction -> Map Addr [W256]
txAccessMap Transaction
tx
         , vmoptAllowFFI :: Bool
vmoptAllowFFI      = Bool
False
         })
        Map Addr Contract
checkState
        Map Addr Contract
postState
          where
            toAddr :: Addr
toAddr = Addr -> Maybe Addr -> Addr
forall a. a -> Maybe a -> a
fromMaybe (Addr -> W256 -> Addr
EVM.createAddress Addr
origin W256
senderNonce) (Transaction -> Maybe Addr
txToAddr Transaction
tx)
            senderNonce :: W256
senderNonce = Word -> W256
EVM.wordValue (Word -> W256) -> Word -> W256
forall a b. (a -> b) -> a -> b
$ 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
origin ((Contract -> Const Word Contract)
 -> Map Addr Contract -> Const Word (Map Addr Contract))
-> Getting Word Contract Word
-> Getting Word (Map Addr Contract) Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word Contract Word
Lens' Contract Word
nonce) Map Addr Contract
preState
            feeSchedule :: FeeSchedule Integer
feeSchedule = FeeSchedule Integer
forall n. Num n => FeeSchedule n
EVM.FeeSchedule.berlin
            toCode :: Maybe Contract
toCode = Addr -> Map Addr Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
toAddr Map Addr Contract
preState
            theCode :: ContractCode
theCode = if Bool
isCreate
                      then Buffer -> ContractCode
EVM.InitCode (ByteString -> Buffer
ConcreteBuffer (Transaction -> ByteString
txData Transaction
tx))
                      else ContractCode
-> (Contract -> ContractCode) -> Maybe Contract -> ContractCode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Buffer -> ContractCode
EVM.RuntimeCode Buffer
forall a. Monoid a => a
mempty) (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode) Maybe Contract
toCode
            effectiveGasPrice :: W256
effectiveGasPrice = Transaction -> W256 -> W256
effectiveprice Transaction
tx (Block -> W256
blockBaseFee Block
block)
            cd :: (Buffer, SymWord)
cd = if Bool
isCreate
                 then (Buffer
forall a. Monoid a => a
mempty, SymWord
0)
                 else let l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
num (Int -> Word) -> (ByteString -> Int) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString
txData Transaction
tx
                      in (ByteString -> Buffer
ConcreteBuffer (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$ Transaction -> ByteString
txData Transaction
tx, Word -> SymWord
litWord Word
l)

effectiveprice :: Transaction -> W256 -> W256
effectiveprice :: Transaction -> W256 -> W256
effectiveprice Transaction
tx W256
baseFee = Transaction -> W256 -> W256
priorityFee Transaction
tx W256
baseFee W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
baseFee

priorityFee :: Transaction -> W256 -> W256
priorityFee :: Transaction -> W256 -> W256
priorityFee Transaction
tx W256
baseFee = let
    (W256
txPrioMax, W256
txMaxFee) = case Transaction -> TxType
txType Transaction
tx of
               TxType
EIP1559Transaction ->
                 let Just W256
maxPrio = Transaction -> Maybe W256
txMaxPriorityFeeGas Transaction
tx
                     Just W256
maxFee = Transaction -> Maybe W256
txMaxFeePerGas Transaction
tx
                 in (W256
maxPrio, W256
maxFee)
               TxType
_ ->
                 let Just W256
gasPrice = Transaction -> Maybe W256
txGasPrice Transaction
tx
                 in (W256
gasPrice, W256
gasPrice)
  in W256 -> W256 -> W256
forall a. Ord a => a -> a -> a
min W256
txPrioMax (W256
txMaxFee W256 -> W256 -> W256
forall a. Num a => a -> a -> a
- W256
baseFee)

maxBaseFee :: Transaction -> W256
maxBaseFee :: Transaction -> W256
maxBaseFee Transaction
tx =
  case Transaction -> TxType
txType Transaction
tx of
     TxType
EIP1559Transaction ->
       let Just W256
maxFee = Transaction -> Maybe W256
txMaxFeePerGas Transaction
tx
       in W256
maxFee
     TxType
_ ->
       let Just W256
gasPrice = Transaction -> Maybe W256
txGasPrice Transaction
tx
       in W256
gasPrice


validateTx :: Transaction -> Block -> Map Addr EVM.Contract -> Maybe ()
validateTx :: Transaction -> Block -> Map Addr Contract -> Maybe ()
validateTx Transaction
tx Block
block Map Addr Contract
cs = do
  Addr
origin        <- Int -> Transaction -> Maybe Addr
sender Int
1 Transaction
tx
  Word
originBalance <- (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
balance) (Contract -> Word) -> Maybe Contract -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Contract) (Map Addr Contract) (Maybe Contract)
-> Map Addr Contract -> Maybe Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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
origin) Map Addr Contract
cs
  Word
originNonce   <- (Getting Word Contract Word -> Contract -> Word
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word Contract Word
Lens' Contract Word
nonce)   (Contract -> Word) -> Maybe Contract -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Contract) (Map Addr Contract) (Maybe Contract)
-> Map Addr Contract -> Maybe Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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
origin) Map Addr Contract
cs
  let gasDeposit :: Word
gasDeposit = W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ (Transaction -> W256 -> W256
effectiveprice Transaction
tx (Block -> W256
blockBaseFee Block
block)) W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* (Transaction -> W256
txGasLimit Transaction
tx)
  if Word
gasDeposit Word -> Word -> Word
forall a. Num a => a -> a -> a
+ (W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ Transaction -> W256
txValue Transaction
tx) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
originBalance
    Bool -> Bool -> Bool
&& (W256 -> Word
w256 (W256 -> Word) -> W256 -> Word
forall a b. (a -> b) -> a -> b
$ Transaction -> W256
txNonce Transaction
tx) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
originNonce Bool -> Bool -> Bool
&& Block -> W256
blockBaseFee Block
block W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
<= Transaction -> W256
maxBaseFee Transaction
tx
  then () -> Maybe ()
forall a. a -> Maybe a
Just ()
  else Maybe ()
forall a. Maybe a
Nothing

checkTx :: Transaction -> Block -> Map Addr EVM.Contract -> Maybe (Map Addr EVM.Contract)
checkTx :: Transaction
-> Block -> Map Addr Contract -> Maybe (Map Addr Contract)
checkTx Transaction
tx Block
block Map Addr Contract
prestate = do
  Addr
origin <- Int -> Transaction -> Maybe Addr
sender Int
1 Transaction
tx
  Transaction -> Block -> Map Addr Contract -> Maybe ()
validateTx Transaction
tx Block
block Map Addr Contract
prestate
  let isCreate :: Bool
isCreate   = Maybe Addr -> Bool
forall a. Maybe a -> Bool
isNothing (Transaction -> Maybe Addr
txToAddr Transaction
tx)
      senderNonce :: W256
senderNonce = Word -> W256
EVM.wordValue (Word -> W256) -> Word -> W256
forall a b. (a -> b) -> a -> b
$ 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
origin ((Contract -> Const Word Contract)
 -> Map Addr Contract -> Const Word (Map Addr Contract))
-> Getting Word Contract Word
-> Getting Word (Map Addr Contract) Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word Contract Word
Lens' Contract Word
nonce) Map Addr Contract
prestate
      toAddr :: Addr
toAddr      = Addr -> Maybe Addr -> Addr
forall a. a -> Maybe a -> a
fromMaybe (Addr -> W256 -> Addr
EVM.createAddress Addr
origin W256
senderNonce) (Transaction -> Maybe Addr
txToAddr Transaction
tx)
      prevCode :: ContractCode
prevCode    = Getting ContractCode (Map Addr Contract) ContractCode
-> Map Addr Contract -> ContractCode
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 ContractCode Contract)
 -> Map Addr Contract -> Const ContractCode (Map Addr Contract))
-> Getting ContractCode Contract ContractCode
-> Getting ContractCode (Map Addr Contract) ContractCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode) Map Addr Contract
prestate
      prevNonce :: Word
prevNonce   = 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))
-> Getting Word Contract Word
-> Getting Word (Map Addr Contract) Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word Contract Word
Lens' Contract Word
nonce) Map Addr Contract
prestate
  if Bool
isCreate Bool -> Bool -> Bool
&& ((case ContractCode
prevCode of {EVM.RuntimeCode Buffer
b -> Buffer -> Int
len Buffer
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0; ContractCode
_ -> Bool
True}) Bool -> Bool -> Bool
|| (Word
prevNonce Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0))
  then Maybe (Map Addr Contract)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  else
    Map Addr Contract -> Maybe (Map Addr Contract)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Addr Contract -> Maybe (Map Addr Contract))
-> Map Addr Contract -> Maybe (Map Addr Contract)
forall a b. (a -> b) -> a -> b
$ Map Addr Contract
prestate

vmForCase :: Case -> EVM.VM
vmForCase :: Case -> VM
vmForCase Case
x =
  let
    vm :: VM
vm = VMOpts -> VM
EVM.makeVm (Case -> VMOpts
testVmOpts Case
x)
      VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM (Map Addr Contract) (Map Addr Contract)
-> Map Addr Contract -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((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)
-> ASetter VM VM (Map Addr Contract) (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
EVM.contracts) (Case -> Map Addr Contract
checkContracts Case
x)
  in
    VM -> VM
initTx VM
vm