{-# Language PartialTypeSignatures #-}
{-# Language FlexibleInstances #-}
{-# Language ExtendedDefaultRules #-}
{-# Language PatternSynonyms #-}
{-# Language RecordWildCards #-}
{-# Language ScopedTypeVariables #-}
{-# Language ViewPatterns #-}
module EVM.Facts
( File (..)
, Fact (..)
, Data (..)
, Path (..)
, apply
, applyCache
, cacheFacts
, contractFacts
, vmFacts
, factToFile
, fileToFact
) where
import EVM (VM, Contract, Cache)
import EVM.Symbolic (litWord, forceLit)
import EVM (balance, nonce, storage, bytecode, env, contracts, contract, state, cache, fetched)
import EVM.Types (Addr, Word, SymWord, Buffer(..))
import qualified EVM
import Prelude hiding (Word)
import Control.Lens (view, set, at, ix, (&), over, assign)
import Control.Monad.State.Strict (execState, when)
import Data.ByteString (ByteString)
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Set (Set)
import Text.Read (readMaybe)
import qualified Data.ByteString.Base16 as BS16
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Map as Map
import qualified Data.Set as Set
type ASCII = ByteString
default (ASCII)
data Fact
= BalanceFact { Fact -> Addr
addr :: Addr, Fact -> Word
what :: Word }
| NonceFact { addr :: Addr, what :: Word }
| StorageFact { addr :: Addr, what :: Word, Fact -> Word
which :: Word }
| CodeFact { addr :: Addr, Fact -> ByteString
blob :: ByteString }
deriving (Fact -> Fact -> Bool
(Fact -> Fact -> Bool) -> (Fact -> Fact -> Bool) -> Eq Fact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fact -> Fact -> Bool
$c/= :: Fact -> Fact -> Bool
== :: Fact -> Fact -> Bool
$c== :: Fact -> Fact -> Bool
Eq, Int -> Fact -> ShowS
[Fact] -> ShowS
Fact -> String
(Int -> Fact -> ShowS)
-> (Fact -> String) -> ([Fact] -> ShowS) -> Show Fact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fact] -> ShowS
$cshowList :: [Fact] -> ShowS
show :: Fact -> String
$cshow :: Fact -> String
showsPrec :: Int -> Fact -> ShowS
$cshowsPrec :: Int -> Fact -> ShowS
Show)
data Path = Path [ASCII] ASCII
deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Eq Path
Eq Path =>
(Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)
newtype Data = Data { Data -> ByteString
dataASCII :: ASCII }
deriving (Data -> Data -> Bool
(Data -> Data -> Bool) -> (Data -> Data -> Bool) -> Eq Data
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Data -> Data -> Bool
$c/= :: Data -> Data -> Bool
== :: Data -> Data -> Bool
$c== :: Data -> Data -> Bool
Eq, Eq Data
Eq Data =>
(Data -> Data -> Ordering)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Data)
-> (Data -> Data -> Data)
-> Ord Data
Data -> Data -> Bool
Data -> Data -> Ordering
Data -> Data -> Data
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Data -> Data -> Data
$cmin :: Data -> Data -> Data
max :: Data -> Data -> Data
$cmax :: Data -> Data -> Data
>= :: Data -> Data -> Bool
$c>= :: Data -> Data -> Bool
> :: Data -> Data -> Bool
$c> :: Data -> Data -> Bool
<= :: Data -> Data -> Bool
$c<= :: Data -> Data -> Bool
< :: Data -> Data -> Bool
$c< :: Data -> Data -> Bool
compare :: Data -> Data -> Ordering
$ccompare :: Data -> Data -> Ordering
$cp1Ord :: Eq Data
Ord, Int -> Data -> ShowS
[Data] -> ShowS
Data -> String
(Int -> Data -> ShowS)
-> (Data -> String) -> ([Data] -> ShowS) -> Show Data
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Data] -> ShowS
$cshowList :: [Data] -> ShowS
show :: Data -> String
$cshow :: Data -> String
showsPrec :: Int -> Data -> ShowS
$cshowsPrec :: Int -> Data -> ShowS
Show)
data File = File { File -> Path
filePath :: Path, File -> Data
fileData :: Data }
deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq, Eq File
Eq File =>
(File -> File -> Ordering)
-> (File -> File -> Bool)
-> (File -> File -> Bool)
-> (File -> File -> Bool)
-> (File -> File -> Bool)
-> (File -> File -> File)
-> (File -> File -> File)
-> Ord File
File -> File -> Bool
File -> File -> Ordering
File -> File -> File
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: File -> File -> File
$cmin :: File -> File -> File
max :: File -> File -> File
$cmax :: File -> File -> File
>= :: File -> File -> Bool
$c>= :: File -> File -> Bool
> :: File -> File -> Bool
$c> :: File -> File -> Bool
<= :: File -> File -> Bool
$c<= :: File -> File -> Bool
< :: File -> File -> Bool
$c< :: File -> File -> Bool
compare :: File -> File -> Ordering
$ccompare :: File -> File -> Ordering
$cp1Ord :: Eq File
Ord, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show)
class AsASCII a where
dump :: a -> ASCII
load :: ASCII -> Maybe a
instance AsASCII Addr where
dump :: Addr -> ByteString
dump = String -> ByteString
Char8.pack (String -> ByteString) -> (Addr -> String) -> Addr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> String
forall a. Show a => a -> String
show
load :: ByteString -> Maybe Addr
load = String -> Maybe Addr
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Addr)
-> (ByteString -> String) -> ByteString -> Maybe Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Char8.unpack
instance AsASCII Word where
dump :: Word -> ByteString
dump = String -> ByteString
Char8.pack (String -> ByteString) -> (Word -> String) -> Word -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> String
forall a. Show a => a -> String
show
load :: ByteString -> Maybe Word
load = String -> Maybe Word
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Word)
-> (ByteString -> String) -> ByteString -> Maybe Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Char8.unpack
instance AsASCII ByteString where
dump :: ByteString -> ByteString
dump x :: ByteString
x = ByteString -> ByteString
BS16.encode ByteString
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> "\n"
load :: ByteString -> Maybe ByteString
load x :: ByteString
x =
case ByteString -> (ByteString, ByteString)
BS16.decode (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split 10 (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
x of
(y :: ByteString
y, "") -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
y
_ -> Maybe ByteString
forall a. Maybe a
Nothing
contractFacts :: Addr -> Contract -> [Fact]
contractFacts :: Addr -> Contract -> [Fact]
contractFacts a :: Addr
a x :: Contract
x = case Getting Buffer Contract Buffer -> Contract -> Buffer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Buffer Contract Buffer
Getter Contract Buffer
bytecode Contract
x of
ConcreteBuffer b :: ByteString
b ->
Addr -> Contract -> [Fact]
storageFacts Addr
a Contract
x [Fact] -> [Fact] -> [Fact]
forall a. [a] -> [a] -> [a]
++
[ Addr -> Word -> Fact
BalanceFact Addr
a (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
x)
, Addr -> Word -> Fact
NonceFact Addr
a (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
x)
, Addr -> ByteString -> Fact
CodeFact Addr
a ByteString
b
]
SymbolicBuffer b :: [SWord 8]
b ->
Addr -> Contract -> [Fact]
storageFacts Addr
a Contract
x [Fact] -> [Fact] -> [Fact]
forall a. [a] -> [a] -> [a]
++
[ Addr -> Word -> Fact
BalanceFact Addr
a (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
x)
, Addr -> Word -> Fact
NonceFact Addr
a (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
x)
]
storageFacts :: Addr -> Contract -> [Fact]
storageFacts :: Addr -> Contract -> [Fact]
storageFacts a :: Addr
a x :: Contract
x = 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
x of
EVM.Symbolic _ _ -> []
EVM.Concrete s :: Map Word SymWord
s -> ((Word, SymWord) -> Fact) -> [(Word, SymWord)] -> [Fact]
forall a b. (a -> b) -> [a] -> [b]
map (Word, SymWord) -> Fact
f (Map Word SymWord -> [(Word, SymWord)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Word SymWord
s)
where
f :: (Word, SymWord) -> Fact
f :: (Word, SymWord) -> Fact
f (k :: Word
k, v :: SymWord
v) = StorageFact :: Addr -> Word -> Word -> Fact
StorageFact
{ addr :: Addr
addr = Addr
a
, what :: Word
what = Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SymWord -> Word
forceLit SymWord
v)
, which :: Word
which = Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
k
}
cacheFacts :: Cache -> Set Fact
cacheFacts :: Cache -> Set Fact
cacheFacts c :: Cache
c = [Fact] -> Set Fact
forall a. Ord a => [a] -> Set a
Set.fromList ([Fact] -> Set Fact) -> [Fact] -> Set Fact
forall a b. (a -> b) -> a -> b
$ do
(k :: Addr
k, v :: Contract
v) <- Map Addr Contract -> [(Addr, Contract)]
forall k a. Map k a -> [(k, a)]
Map.toList (Getting (Map Addr Contract) Cache (Map Addr Contract)
-> Cache -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Addr Contract) Cache (Map Addr Contract)
Lens' Cache (Map Addr Contract)
EVM.fetched Cache
c)
Addr -> Contract -> [Fact]
contractFacts Addr
k Contract
v
vmFacts :: VM -> Set Fact
vmFacts :: VM -> Set Fact
vmFacts vm :: VM
vm = [Fact] -> Set Fact
forall a. Ord a => [a] -> Set a
Set.fromList ([Fact] -> Set Fact) -> [Fact] -> Set Fact
forall a b. (a -> b) -> a -> b
$ do
(k :: Addr
k, v :: Contract
v) <- Map Addr Contract -> [(Addr, Contract)]
forall k a. Map k a -> [(k, a)]
Map.toList (Getting (Map Addr Contract) VM (Map Addr Contract)
-> VM -> Map Addr Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM
Lens' VM Env
env ((Env -> Const (Map Addr Contract) Env)
-> VM -> Const (Map Addr Contract) VM)
-> ((Map Addr Contract
-> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env)
-> Getting (Map Addr Contract) VM (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract
-> Const (Map Addr Contract) (Map Addr Contract))
-> Env -> Const (Map Addr Contract) Env
Lens' Env (Map Addr Contract)
contracts) VM
vm)
Addr -> Contract -> [Fact]
contractFacts Addr
k Contract
v
apply1 :: VM -> Fact -> VM
apply1 :: VM -> Fact -> VM
apply1 vm :: VM
vm fact :: Fact
fact =
case Fact
fact of
CodeFact {..} -> (State VM () -> VM -> VM) -> VM -> State VM () -> VM
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VM () -> VM -> VM
forall s a. State s a -> s -> s
execState VM
vm (State VM () -> VM) -> State VM () -> VM
forall a b. (a -> b) -> a -> b
$ do
ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> State VM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
-> Env -> Identity Env)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env)
-> ((Maybe Contract -> Identity (Maybe Contract))
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just (ContractCode -> Contract
EVM.initialContract (Buffer -> ContractCode
EVM.RuntimeCode (ByteString -> Buffer
ConcreteBuffer ByteString
blob))))
Bool -> State VM () -> State VM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
-> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract) VM
vm Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
addr) (State VM () -> State VM ()) -> State VM () -> State VM ()
forall a b. (a -> b) -> a -> b
$ Addr -> State VM ()
EVM.loadContract Addr
addr
StorageFact {..} ->
VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Storage Storage -> (Storage -> Storage) -> VM -> VM
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Env -> Identity Env) -> VM -> Identity VM
Lens' VM Env
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Env -> Identity Env)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env)
-> ((Storage -> Identity Storage)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Storage -> Identity Storage) -> Contract -> Identity Contract)
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Storage -> Identity Storage) -> Contract -> Identity Contract
Lens' Contract Storage
storage) (SymWord -> SymWord -> Storage -> Storage
EVM.writeStorage (Word -> SymWord
litWord Word
which) (Word -> SymWord
litWord Word
what))
BalanceFact {..} ->
VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Word Word -> Word -> 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
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Env -> Identity Env)
-> ASetter VM VM Word Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env)
-> ((Word -> Identity Word)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Word -> Identity Word)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Identity Word)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
balance) Word
what
NonceFact {..} ->
VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Word Word -> Word -> 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
env ((Env -> Identity Env) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Env -> Identity Env)
-> ASetter VM VM Word Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env
Lens' Env (Map Addr Contract)
contracts ((Map Addr Contract -> Identity (Map Addr Contract))
-> Env -> Identity Env)
-> ((Word -> Identity Word)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Word -> Identity Word)
-> Env
-> Identity Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Identity Word)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
nonce) Word
what
apply2 :: VM -> Fact -> VM
apply2 :: VM -> Fact -> VM
apply2 vm :: VM
vm fact :: Fact
fact =
case Fact
fact of
CodeFact {..} -> (State VM () -> VM -> VM) -> VM -> State VM () -> VM
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VM () -> VM -> VM
forall s a. State s a -> s -> s
execState VM
vm (State VM () -> VM) -> State VM () -> VM
forall a b. (a -> b) -> a -> b
$ do
ASetter VM VM (Maybe Contract) (Maybe Contract)
-> Maybe Contract -> State VM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Maybe Contract -> Identity (Maybe Contract))
-> Cache -> Identity Cache)
-> ASetter VM VM (Maybe Contract) (Maybe Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache)
-> ((Maybe Contract -> Identity (Maybe Contract))
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Maybe Contract -> Identity (Maybe Contract))
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just (ContractCode -> Contract
EVM.initialContract (Buffer -> ContractCode
EVM.RuntimeCode (ByteString -> Buffer
ConcreteBuffer ByteString
blob))))
Bool -> State VM () -> State VM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Addr VM Addr -> VM -> Addr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM
Lens' VM FrameState
state ((FrameState -> Const Addr FrameState) -> VM -> Const Addr VM)
-> ((Addr -> Const Addr Addr)
-> FrameState -> Const Addr FrameState)
-> Getting Addr VM Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> Const Addr Addr) -> FrameState -> Const Addr FrameState
Lens' FrameState Addr
contract) VM
vm Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
addr) (State VM () -> State VM ()) -> State VM () -> State VM ()
forall a b. (a -> b) -> a -> b
$ Addr -> State VM ()
EVM.loadContract Addr
addr
StorageFact {..} ->
VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Storage Storage -> (Storage -> Storage) -> VM -> VM
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Storage -> Identity Storage) -> Cache -> Identity Cache)
-> ASetter VM VM Storage Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache)
-> ((Storage -> Identity Storage)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Storage -> Identity Storage)
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Storage -> Identity Storage) -> Contract -> Identity Contract)
-> (Storage -> Identity Storage)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Storage -> Identity Storage) -> Contract -> Identity Contract
Lens' Contract Storage
storage) (SymWord -> SymWord -> Storage -> Storage
EVM.writeStorage (Word -> SymWord
litWord Word
which) (Word -> SymWord
litWord Word
what))
BalanceFact {..} ->
VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Word Word -> Word -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Cache -> Identity Cache)
-> ASetter VM VM Word Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache)
-> ((Word -> Identity Word)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Word -> Identity Word)
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Identity Word)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
balance) Word
what
NonceFact {..} ->
VM
vm VM -> (VM -> VM) -> VM
forall a b. a -> (a -> b) -> b
& ASetter VM VM Word Word -> Word -> VM -> VM
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Cache -> Identity Cache) -> VM -> Identity VM
Lens' VM Cache
cache ((Cache -> Identity Cache) -> VM -> Identity VM)
-> ((Word -> Identity Word) -> Cache -> Identity Cache)
-> ASetter VM VM Word Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache
Lens' Cache (Map Addr Contract)
fetched ((Map Addr Contract -> Identity (Map Addr Contract))
-> Cache -> Identity Cache)
-> ((Word -> Identity Word)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> (Word -> Identity Word)
-> Cache
-> Identity Cache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Addr Contract)
-> Traversal' (Map Addr Contract) (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr ((Contract -> Identity Contract)
-> Map Addr Contract -> Identity (Map Addr Contract))
-> ((Word -> Identity Word) -> Contract -> Identity Contract)
-> (Word -> Identity Word)
-> Map Addr Contract
-> Identity (Map Addr Contract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Identity Word) -> Contract -> Identity Contract
Lens' Contract Word
nonce) Word
what
instance Ord Fact where
compare :: Fact -> Fact -> Ordering
compare = (Fact -> (Int, Addr, Word)) -> Fact -> Fact -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Fact -> (Int, Addr, Word)
f
where
f :: Fact -> (Int, Addr, Word)
f :: Fact -> (Int, Addr, Word)
f (CodeFact a :: Addr
a _) = (0, Addr
a, 0)
f (BalanceFact a :: Addr
a _) = (1, Addr
a, 0)
f (NonceFact a :: Addr
a _) = (2, Addr
a, 0)
f (StorageFact a :: Addr
a _ x :: Word
x) = (3, Addr
a, Word
x)
apply :: VM -> Set Fact -> VM
apply :: VM -> Set Fact -> VM
apply =
(VM -> Fact -> VM) -> VM -> Set Fact -> VM
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl VM -> Fact -> VM
apply1
applyCache :: VM -> Set Fact -> VM
applyCache :: VM -> Set Fact -> VM
applyCache =
(VM -> Fact -> VM) -> VM -> Set Fact -> VM
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl VM -> Fact -> VM
apply2
factToFile :: Fact -> File
factToFile :: Fact -> File
factToFile fact :: Fact
fact = case Fact
fact of
StorageFact {..} -> [ByteString] -> ByteString -> Word -> File
forall a. AsASCII a => [ByteString] -> ByteString -> a -> File
mk ["storage"] (Word -> ByteString
forall a. AsASCII a => a -> ByteString
dump Word
which) Word
what
BalanceFact {..} -> [ByteString] -> ByteString -> Word -> File
forall a. AsASCII a => [ByteString] -> ByteString -> a -> File
mk [] "balance" Word
what
NonceFact {..} -> [ByteString] -> ByteString -> Word -> File
forall a. AsASCII a => [ByteString] -> ByteString -> a -> File
mk [] "nonce" Word
what
CodeFact {..} -> [ByteString] -> ByteString -> ByteString -> File
forall a. AsASCII a => [ByteString] -> ByteString -> a -> File
mk [] "code" ByteString
blob
where
mk :: AsASCII a => [ASCII] -> ASCII -> a -> File
mk :: [ByteString] -> ByteString -> a -> File
mk prefix :: [ByteString]
prefix base :: ByteString
base a :: a
a =
Path -> Data -> File
File ([ByteString] -> ByteString -> Path
Path (Addr -> ByteString
forall a. AsASCII a => a -> ByteString
dump (Fact -> Addr
addr Fact
fact) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
prefix) ByteString
base)
(ByteString -> Data
Data (ByteString -> Data) -> ByteString -> Data
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. AsASCII a => a -> ByteString
dump a
a)
pattern Load :: AsASCII a => a -> ASCII
pattern $mLoad :: forall r a.
AsASCII a =>
ByteString -> (a -> r) -> (Void# -> r) -> r
Load x <- (load -> Just x)
fileToFact :: File -> Maybe Fact
fileToFact :: File -> Maybe Fact
fileToFact = \case
File (Path [Load a :: Addr
a] "code") (Data (Load x :: ByteString
x))
-> Fact -> Maybe Fact
forall a. a -> Maybe a
Just (Addr -> ByteString -> Fact
CodeFact Addr
a ByteString
x)
File (Path [Load a :: Addr
a] "balance") (Data (Load x :: Word
x))
-> Fact -> Maybe Fact
forall a. a -> Maybe a
Just (Addr -> Word -> Fact
BalanceFact Addr
a Word
x)
File (Path [Load a :: Addr
a] "nonce") (Data (Load x :: Word
x))
-> Fact -> Maybe Fact
forall a. a -> Maybe a
Just (Addr -> Word -> Fact
NonceFact Addr
a Word
x)
File (Path [Load a :: Addr
a, "storage"] (Load x :: Word
x)) (Data (Load y :: Word
y))
-> Fact -> Maybe Fact
forall a. a -> Maybe a
Just (Addr -> Word -> Word -> Fact
StorageFact Addr
a Word
y Word
x)
_
-> Maybe Fact
forall a. Maybe a
Nothing