{-# Language PartialTypeSignatures #-}
{-# Language DataKinds #-}
{-# Language ExtendedDefaultRules #-}
{-# Language PatternSynonyms #-}

-- Converts between Ethereum contract states and simple trees of
-- texts.  Dumps and loads such trees as Git repositories (the state
-- gets serialized as commits with folders and files).
--
-- Example state file hierarchy:
--
--   /0123...abc/balance      says "0x500"
--   /0123...abc/code         says "60023429..."
--   /0123...abc/nonce        says "0x3"
--   /0123...abc/storage/0x1  says "0x1"
--   /0123...abc/storage/0x2  says "0x0"
--
-- This format could easily be serialized into any nested record
-- syntax, e.g. JSON.

module EVM.Facts
  ( File (..)
  , Fact (..)
  , Data (..)
  , Path (..)
  , apply
  , applyCache
  , cacheFacts
  , contractFacts
  , vmFacts
  , factToFile
  , fileToFact
  ) where

import EVM          (bytecode)
import EVM.Expr     (writeStorage, litAddr)
import EVM.Types

import qualified EVM

import Prelude hiding (Word)

import Optics.Core
import Optics.State

import Control.Monad.State.Strict (execState, when)
import Data.ByteString (ByteString)
import Data.Ord        (comparing)
import Data.Set        (Set)
import Data.Map        (Map)
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

-- We treat everything as ASCII byte strings because
-- we only use hex digits (and the letter 'x').
type ASCII = ByteString

-- When using string literals, default to infer the ASCII type.
default (ASCII)

-- We use the word "fact" to mean one piece of serializable
-- information about the state.
--
-- Note that Haskell allows this kind of union of records.
-- It's convenient here, but typically avoided.
data Fact
  = BalanceFact { Fact -> Addr
addr :: Addr, Fact -> W256
what :: W256 }
  | NonceFact   { addr :: Addr, what :: W256 }
  | StorageFact { addr :: Addr, what :: W256, Fact -> W256
which :: W256 }
  | CodeFact    { addr :: Addr, Fact -> ASCII
blob :: ByteString }
  deriving (Fact -> Fact -> Bool
forall (a :: OpticKind).
(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
forall (a :: OpticKind).
(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)

-- A fact path means something like "/0123...abc/storage/0x1",
-- or alternatively "contracts['0123...abc'].storage['0x1']".
data Path = Path [ASCII] ASCII
  deriving (Path -> Path -> Bool
forall (a :: OpticKind).
(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
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall (a :: OpticKind).
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
Ord, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
forall (a :: OpticKind).
(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)

-- A fact data is the content of a file.  We encapsulate it
-- with a newtype to make it easier to change the representation
-- (to use bytestrings, some sum type, or whatever).
newtype Data = Data { Data -> ASCII
dataASCII :: ASCII }
  deriving (Data -> Data -> Bool
forall (a :: OpticKind).
(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
Data -> Data -> Bool
Data -> Data -> Ordering
Data -> Data -> Data
forall (a :: OpticKind).
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
Ord, Int -> Data -> ShowS
[Data] -> ShowS
Data -> String
forall (a :: OpticKind).
(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)

-- We use the word "file" to denote a serialized value at a path.
data File = File { File -> Path
filePath :: Path, File -> Data
fileData :: Data }
  deriving (File -> File -> Bool
forall (a :: OpticKind).
(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
File -> File -> Bool
File -> File -> Ordering
File -> File -> File
forall (a :: OpticKind).
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
Ord, Int -> File -> ShowS
[File] -> ShowS
File -> String
forall (a :: OpticKind).
(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 -> ASCII
dump = String -> ASCII
Char8.pack forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> String
show
  load :: ASCII -> Maybe Addr
load = forall (a :: OpticKind). Read a => String -> Maybe a
readMaybe forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ASCII -> String
Char8.unpack

instance AsASCII W256 where
  dump :: W256 -> ASCII
dump = String -> ASCII
Char8.pack forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Show a => a -> String
show
  load :: ASCII -> Maybe W256
load = forall (a :: OpticKind). Read a => String -> Maybe a
readMaybe forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ASCII -> String
Char8.unpack

instance AsASCII ByteString where
  dump :: ASCII -> ASCII
dump ASCII
x = ASCII -> ASCII
BS16.encodeBase16' ASCII
x forall (a :: OpticKind). Semigroup a => a -> a -> a
<> ASCII
"\n"
  load :: ASCII -> Maybe ASCII
load ASCII
x =
    case ASCII -> Either Text ASCII
BS16.decodeBase16 forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (a :: OpticKind). Monoid a => [a] -> a
mconcat forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word8 -> ASCII -> [ASCII]
BS.split Word8
10 forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ASCII
x of
      Right ASCII
y -> forall (a :: OpticKind). a -> Maybe a
Just ASCII
y
      Either Text ASCII
_       -> forall (a :: OpticKind). Maybe a
Nothing

contractFacts :: Addr -> Contract -> Map W256 (Map W256 W256) -> [Fact]
contractFacts :: Addr -> Contract -> Map W256 (Map W256 W256) -> [Fact]
contractFacts Addr
a Contract
x Map W256 (Map W256 W256)
store = case forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Expr 'Buf)
bytecode Contract
x of
  ConcreteBuf ASCII
b ->
    Addr -> Map W256 (Map W256 W256) -> [Fact]
storageFacts Addr
a Map W256 (Map W256 W256)
store forall (a :: OpticKind). [a] -> [a] -> [a]
++
    [ Addr -> W256 -> Fact
BalanceFact Addr
a Contract
x.balance
    , Addr -> W256 -> Fact
NonceFact   Addr
a Contract
x.nonce
    , Addr -> ASCII -> Fact
CodeFact    Addr
a ASCII
b
    ]
  Expr 'Buf
_ ->
    -- here simply ignore storing the bytecode
    Addr -> Map W256 (Map W256 W256) -> [Fact]
storageFacts Addr
a Map W256 (Map W256 W256)
store forall (a :: OpticKind). [a] -> [a] -> [a]
++
    [ Addr -> W256 -> Fact
BalanceFact Addr
a Contract
x.balance
    , Addr -> W256 -> Fact
NonceFact   Addr
a Contract
x.nonce
    ]


storageFacts :: Addr -> Map W256 (Map W256 W256) -> [Fact]
storageFacts :: Addr -> Map W256 (Map W256 W256) -> [Fact]
storageFacts Addr
a Map W256 (Map W256 W256)
store = forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (W256, W256) -> Fact
f (forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
a -> k -> Map k a -> a
Map.findWithDefault forall (k :: OpticKind) (a :: OpticKind). Map k a
Map.empty (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
a) Map W256 (Map W256 W256)
store))
  where
    f :: (W256, W256) -> Fact
    f :: (W256, W256) -> Fact
f (W256
k, W256
v) = StorageFact
      { $sel:addr:BalanceFact :: Addr
addr  = Addr
a
      , $sel:what:BalanceFact :: W256
what  = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral W256
v
      , $sel:which:BalanceFact :: W256
which = forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
fromIntegral W256
k
      }

cacheFacts :: Cache -> Set Fact
cacheFacts :: Cache -> Set Fact
cacheFacts Cache
c = forall (a :: OpticKind). Ord a => [a] -> Set a
Set.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  (Addr
k, Contract
v) <- forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList Cache
c.fetchedContracts
  Addr -> Contract -> Map W256 (Map W256 W256) -> [Fact]
contractFacts Addr
k Contract
v Cache
c.fetchedStorage

vmFacts :: VM -> Set Fact
vmFacts :: VM -> Set Fact
vmFacts VM
vm = forall (a :: OpticKind). Ord a => [a] -> Set a
Set.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  (Addr
k, Contract
v) <- forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList VM
vm.env.contracts
  case VM
vm.env.storage of
    Expr 'Storage
EmptyStore -> Addr -> Contract -> Map W256 (Map W256 W256) -> [Fact]
contractFacts Addr
k Contract
v forall (k :: OpticKind) (a :: OpticKind). Map k a
Map.empty
    ConcreteStore Map W256 (Map W256 W256)
s -> Addr -> Contract -> Map W256 (Map W256 W256) -> [Fact]
contractFacts Addr
k Contract
v Map W256 (Map W256 W256)
s
    Expr 'Storage
_ -> forall a. HasCallStack => String -> a
error String
"cannot serialize an abstract store"

-- Somewhat stupidly, this function demands that for each contract,
-- the code fact for that contract comes before the other facts for
-- that contract.  This is an incidental thing because right now we
-- always initialize contracts starting with the code (to calculate
-- the code hash and so on).
--
-- Therefore, we need to make sure to sort the fact set in such a way.
apply1 :: VM -> Fact -> VM
apply1 :: VM -> Fact -> VM
apply1 VM
vm Fact
fact =
  case Fact
fact of
    CodeFact    {ASCII
Addr
blob :: ASCII
addr :: Addr
$sel:blob:BalanceFact :: Fact -> ASCII
$sel:addr:BalanceFact :: Fact -> Addr
..} -> forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> b -> a -> c
flip forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> s
execState VM
vm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
      forall (k :: OpticKind) (s :: OpticKind)
       (m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall (a :: OpticKind). a -> Maybe a
Just (ContractCode -> Contract
EVM.initialContract (RuntimeCode -> ContractCode
RuntimeCode (ASCII -> RuntimeCode
ConcreteRuntimeCode ASCII
blob))))
      forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (VM
vm.state.contract forall (a :: OpticKind). Eq a => a -> a -> Bool
== Addr
addr) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> State VM ()
EVM.loadContract Addr
addr
    StorageFact {Addr
W256
which :: W256
what :: W256
addr :: Addr
$sel:which:BalanceFact :: Fact -> W256
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} ->
      VM
vm forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "storage" a => a
#storage) (Expr 'EWord
-> Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (Addr -> Expr 'EWord
litAddr Addr
addr) (W256 -> Expr 'EWord
Lit W256
which) (W256 -> Expr 'EWord
Lit W256
what))
    BalanceFact {Addr
W256
what :: W256
addr :: Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} ->
      VM
vm forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
addr forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "balance" a => a
#balance) W256
what
    NonceFact   {Addr
W256
what :: W256
addr :: Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} ->
      VM
vm forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "env" a => a
#env forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "contracts" a => a
#contracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
addr forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce) W256
what

apply2 :: VM -> Fact -> VM
apply2 :: VM -> Fact -> VM
apply2 VM
vm Fact
fact =
  case Fact
fact of
    CodeFact    {ASCII
Addr
blob :: ASCII
addr :: Addr
$sel:blob:BalanceFact :: Fact -> ASCII
$sel:addr:BalanceFact :: Fact -> Addr
..} -> forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> b -> a -> c
flip forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> s
execState VM
vm forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
      forall (k :: OpticKind) (s :: OpticKind)
       (m :: OpticKind -> OpticKind) (is :: IxList) (a :: OpticKind)
       (b :: OpticKind).
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "fetchedContracts" a => a
#fetchedContracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Addr
addr) (forall (a :: OpticKind). a -> Maybe a
Just (ContractCode -> Contract
EVM.initialContract (RuntimeCode -> ContractCode
RuntimeCode (ASCII -> RuntimeCode
ConcreteRuntimeCode ASCII
blob))))
      forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (VM
vm.state.contract forall (a :: OpticKind). Eq a => a -> a -> Bool
== Addr
addr) forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> State VM ()
EVM.loadContract Addr
addr
    StorageFact {Addr
W256
which :: W256
what :: W256
addr :: Addr
$sel:which:BalanceFact :: Fact -> W256
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} -> let
        store :: Map W256 (Map W256 W256)
store = VM
vm.cache.fetchedStorage
        ctrct :: Map W256 W256
ctrct = forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
a -> k -> Map k a -> a
Map.findWithDefault forall (k :: OpticKind) (a :: OpticKind). Map k a
Map.empty (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
addr) Map W256 (Map W256 W256)
store
      in
        VM
vm forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "fetchedStorage" a => a
#fetchedStorage) (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert (forall (a :: OpticKind) (b :: OpticKind).
(Integral a, Num b) =>
a -> b
num Addr
addr) (forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert W256
which W256
what Map W256 W256
ctrct) Map W256 (Map W256 W256)
store)
    BalanceFact {Addr
W256
what :: W256
addr :: Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} ->
      VM
vm forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "fetchedContracts" a => a
#fetchedContracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
addr forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "balance" a => a
#balance) W256
what
    NonceFact   {Addr
W256
what :: W256
addr :: Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} ->
      VM
vm forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall (a :: OpticKind). IsLabel "cache" a => a
#cache forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "fetchedContracts" a => a
#fetchedContracts forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Addr
addr forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce) W256
what

-- Sort facts in the right order for `apply1` to work.
instance Ord Fact where
  compare :: Fact -> Fact -> Ordering
compare = forall (a :: OpticKind) (b :: OpticKind).
Ord a =>
(b -> a) -> b -> b -> Ordering
comparing Fact -> (Int, Addr, W256)
f
    where
    f :: Fact -> (Int, Addr, W256)
    f :: Fact -> (Int, Addr, W256)
f (CodeFact Addr
a ASCII
_)      = (Int
0, Addr
a, W256
0)
    f (BalanceFact Addr
a W256
_)   = (Int
1, Addr
a, W256
0)
    f (NonceFact Addr
a W256
_)     = (Int
2, Addr
a, W256
0)
    f (StorageFact Addr
a W256
_ W256
x) = (Int
3, Addr
a, W256
x)

-- Applies a set of facts to a VM.
apply :: VM -> Set Fact -> VM
apply :: VM -> Set Fact -> VM
apply =
  -- The set's ordering is relevant; see `apply1`.
  forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
       (a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl VM -> Fact -> VM
apply1
--
-- Applies a set of facts to a VM.
applyCache :: VM -> Set Fact -> VM
applyCache :: VM -> Set Fact -> VM
applyCache =
  -- The set's ordering is relevant; see `apply1`.
  forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
       (a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl VM -> Fact -> VM
apply2

factToFile :: Fact -> File
factToFile :: Fact -> File
factToFile Fact
fact = case Fact
fact of
  StorageFact {Addr
W256
which :: W256
what :: W256
addr :: Addr
$sel:which:BalanceFact :: Fact -> W256
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} -> forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk [ASCII
"storage"] (forall (a :: OpticKind). AsASCII a => a -> ASCII
dump W256
which) W256
what
  BalanceFact {Addr
W256
what :: W256
addr :: Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} -> forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk []          ASCII
"balance"    W256
what
  NonceFact   {Addr
W256
what :: W256
addr :: Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:addr:BalanceFact :: Fact -> Addr
..} -> forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk []          ASCII
"nonce"      W256
what
  CodeFact    {ASCII
Addr
blob :: ASCII
addr :: Addr
$sel:blob:BalanceFact :: Fact -> ASCII
$sel:addr:BalanceFact :: Fact -> Addr
..} -> forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk []          ASCII
"code"       ASCII
blob
  where
    mk :: AsASCII a => [ASCII] -> ASCII -> a -> File
    mk :: forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk [ASCII]
prefix ASCII
base a
a =
      Path -> Data -> File
File ([ASCII] -> ASCII -> Path
Path (forall (a :: OpticKind). AsASCII a => a -> ASCII
dump Fact
fact.addr forall (a :: OpticKind). a -> [a] -> [a]
: [ASCII]
prefix) ASCII
base)
           (ASCII -> Data
Data forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). AsASCII a => a -> ASCII
dump a
a)

-- This lets us easier pattern match on serialized things.
-- Uses language extensions: `PatternSynonyms` and `ViewPatterns`.
pattern Load :: AsASCII a => a -> ASCII
pattern $mLoad :: forall {r} {a :: OpticKind}.
AsASCII a =>
ASCII -> (a -> r) -> ((# #) -> r) -> r
Load x <- (load -> Just x)

fileToFact :: File -> Maybe Fact
fileToFact :: File -> Maybe Fact
fileToFact = \case
  File (Path [Load Addr
a] ASCII
"code")    (Data (Load ASCII
x))
    -> forall (a :: OpticKind). a -> Maybe a
Just (Addr -> ASCII -> Fact
CodeFact Addr
a ASCII
x)
  File (Path [Load Addr
a] ASCII
"balance") (Data (Load W256
x))
    -> forall (a :: OpticKind). a -> Maybe a
Just (Addr -> W256 -> Fact
BalanceFact Addr
a W256
x)
  File (Path [Load Addr
a] ASCII
"nonce")   (Data (Load W256
x))
    -> forall (a :: OpticKind). a -> Maybe a
Just (Addr -> W256 -> Fact
NonceFact Addr
a W256
x)
  File (Path [Load Addr
a, ASCII
"storage"] (Load W256
x)) (Data (Load W256
y))
    -> forall (a :: OpticKind). a -> Maybe a
Just (Addr -> W256 -> W256 -> Fact
StorageFact Addr
a W256
y W256
x)
  File
_
    -> forall (a :: OpticKind). Maybe a
Nothing