{-# 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 qualified
import EVM.Expr (writeStorage, litAddr)
import EVM.Types

import Optics.Core
import Optics.State

import Control.Monad.State.Strict (execState, when)
import Data.ByteString (ByteString)
import Data.ByteString.Base16 qualified as BS16
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as Char8
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Ord (comparing)
import Text.Read (readMaybe)
import Witch (into)

-- 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
(Fact -> Fact -> Bool) -> (Fact -> Fact -> Bool) -> Eq Fact
forall (a :: OpticKind).
(a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fact -> Fact -> Bool
== :: Fact -> Fact -> Bool
$c/= :: Fact -> Fact -> Bool
/= :: Fact -> Fact -> Bool
Eq, Int -> Fact -> ShowS
[Fact] -> ShowS
Fact -> String
(Int -> Fact -> ShowS)
-> (Fact -> String) -> ([Fact] -> ShowS) -> Show Fact
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fact -> ShowS
showsPrec :: Int -> Fact -> ShowS
$cshow :: Fact -> String
show :: Fact -> String
$cshowList :: [Fact] -> ShowS
showList :: [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
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall (a :: OpticKind).
(a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: 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 :: 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
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$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
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [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
(Data -> Data -> Bool) -> (Data -> Data -> Bool) -> Eq Data
forall (a :: OpticKind).
(a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Data -> Data -> Bool
== :: Data -> Data -> Bool
$c/= :: Data -> Data -> Bool
/= :: 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 :: 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
$ccompare :: Data -> Data -> Ordering
compare :: Data -> Data -> Ordering
$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
>= :: Data -> Data -> Bool
$cmax :: Data -> Data -> Data
max :: Data -> Data -> Data
$cmin :: Data -> Data -> Data
min :: Data -> Data -> Data
Ord, Int -> Data -> ShowS
[Data] -> ShowS
Data -> String
(Int -> Data -> ShowS)
-> (Data -> String) -> ([Data] -> ShowS) -> Show Data
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Data -> ShowS
showsPrec :: Int -> Data -> ShowS
$cshow :: Data -> String
show :: Data -> String
$cshowList :: [Data] -> ShowS
showList :: [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
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall (a :: OpticKind).
(a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: File -> File -> Bool
== :: File -> File -> Bool
$c/= :: File -> File -> Bool
/= :: 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 :: 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
$ccompare :: File -> File -> Ordering
compare :: File -> File -> Ordering
$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
>= :: File -> File -> Bool
$cmax :: File -> File -> File
max :: File -> File -> File
$cmin :: File -> File -> File
min :: File -> File -> File
Ord, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> File -> ShowS
showsPrec :: Int -> File -> ShowS
$cshow :: File -> String
show :: File -> String
$cshowList :: [File] -> ShowS
showList :: [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 (String -> ASCII) -> (Addr -> String) -> Addr -> ASCII
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Addr -> String
forall (a :: OpticKind). Show a => a -> String
show
  load :: ASCII -> Maybe Addr
load = String -> Maybe Addr
forall (a :: OpticKind). Read a => String -> Maybe a
readMaybe (String -> Maybe Addr) -> (ASCII -> String) -> ASCII -> Maybe Addr
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 (String -> ASCII) -> (W256 -> String) -> W256 -> ASCII
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. W256 -> String
forall (a :: OpticKind). Show a => a -> String
show
  load :: ASCII -> Maybe W256
load = String -> Maybe W256
forall (a :: OpticKind). Read a => String -> Maybe a
readMaybe (String -> Maybe W256) -> (ASCII -> String) -> ASCII -> Maybe W256
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 ASCII -> ASCII -> ASCII
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> ASCII
"\n"
  load :: ASCII -> Maybe ASCII
load ASCII
x =
    case ASCII -> Either Text ASCII
BS16.decodeBase16 (ASCII -> Either Text ASCII)
-> (ASCII -> ASCII) -> ASCII -> Either Text ASCII
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. [ASCII] -> ASCII
forall (a :: OpticKind). Monoid a => [a] -> a
mconcat ([ASCII] -> ASCII) -> (ASCII -> [ASCII]) -> ASCII -> ASCII
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Word8 -> ASCII -> [ASCII]
BS.split Word8
10 (ASCII -> Either Text ASCII) -> ASCII -> Either Text ASCII
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ASCII
x of
      Right ASCII
y -> ASCII -> Maybe ASCII
forall (a :: OpticKind). a -> Maybe a
Just ASCII
y
      Either Text ASCII
_       -> Maybe 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 Optic' A_Getter NoIx Contract (Expr 'Buf) -> Contract -> Expr 'Buf
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx 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 [Fact] -> [Fact] -> [Fact]
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 [Fact] -> [Fact] -> [Fact]
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 = ((W256, W256) -> Fact) -> [(W256, W256)] -> [Fact]
forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (W256, W256) -> Fact
f (Map W256 W256 -> [(W256, W256)]
forall (k :: OpticKind) (a :: OpticKind). Map k a -> [(k, a)]
Map.toList (Map W256 W256 -> W256 -> Map W256 (Map W256 W256) -> Map W256 W256
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
a -> k -> Map k a -> a
Map.findWithDefault Map W256 W256
forall (k :: OpticKind) (a :: OpticKind). Map k a
Map.empty (Addr -> W256
forall (target :: OpticKind) (source :: OpticKind).
From source target =>
source -> target
into 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  = W256
v
      , $sel:which:BalanceFact :: W256
which = W256
k
      }

cacheFacts :: Cache -> Set Fact
cacheFacts :: Cache -> Set Fact
cacheFacts Cache
c = [Fact] -> Set Fact
forall (a :: OpticKind). Ord a => [a] -> Set a
Set.fromList ([Fact] -> Set Fact) -> [Fact] -> Set Fact
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  (Addr
k, Contract
v) <- Map Addr Contract -> [(Addr, Contract)]
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 = [Fact] -> Set Fact
forall (a :: OpticKind). Ord a => [a] -> Set a
Set.fromList ([Fact] -> Set Fact) -> [Fact] -> Set Fact
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  (Addr
k, Contract
v) <- Map Addr Contract -> [(Addr, Contract)]
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 Map W256 (Map W256 W256)
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
_ -> String -> [Fact]
forall (a :: OpticKind). HasCallStack => String -> a
internalError 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
$sel:addr:BalanceFact :: Fact -> Addr
$sel:blob:BalanceFact :: Fact -> ASCII
addr :: Addr
blob :: ASCII
..} -> (State VM () -> VM -> VM) -> VM -> State VM () -> VM
forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> b -> a -> c
flip State VM () -> VM -> VM
forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> s
execState VM
vm (State VM () -> VM) -> State VM () -> VM
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
      Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> State VM ()
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 (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
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
% Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall (a :: OpticKind). a -> Maybe a
Just (ContractCode -> Contract
EVM.initialContract (RuntimeCode -> ContractCode
RuntimeCode (ASCII -> RuntimeCode
ConcreteRuntimeCode ASCII
blob))))
      Bool -> State VM () -> State VM ()
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (VM
vm.state.contract Addr -> Addr -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== Addr
addr) (State VM () -> State VM ()) -> State VM () -> State VM ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> State VM ()
EVM.loadContract Addr
addr
    StorageFact {Addr
W256
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:which:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
which :: W256
..} ->
      VM
vm VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> VM -> VM
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 (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
-> Optic A_Lens NoIx VM VM (Expr 'Storage) (Expr 'Storage)
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
% Optic A_Lens NoIx Env Env (Expr 'Storage) (Expr 'Storage)
#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
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
..} ->
      VM
vm VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx VM VM W256 W256 -> W256 -> VM -> VM
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 (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
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
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
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
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#balance) W256
what
    NonceFact   {Addr
W256
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
..} ->
      VM
vm VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx VM VM W256 W256 -> W256 -> VM -> VM
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 (Optic A_Lens NoIx VM VM Env Env
#env Optic A_Lens NoIx VM VM Env Env
-> Optic
     A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic A_Lens NoIx Env Env (Map Addr Contract) (Map Addr Contract)
#contracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
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
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
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
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#nonce) W256
what

apply2 :: VM -> Fact -> VM
apply2 :: VM -> Fact -> VM
apply2 VM
vm Fact
fact =
  case Fact
fact of
    CodeFact    {ASCII
Addr
$sel:addr:BalanceFact :: Fact -> Addr
$sel:blob:BalanceFact :: Fact -> ASCII
addr :: Addr
blob :: ASCII
..} -> (State VM () -> VM -> VM) -> VM -> State VM () -> VM
forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> b -> a -> c
flip State VM () -> VM -> VM
forall (s :: OpticKind) (a :: OpticKind). State s a -> s -> s
execState VM
vm (State VM () -> VM) -> State VM () -> VM
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
      Optic
  A_Lens
  NoIx
  VM
  VM
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> State VM ()
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 (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic
  A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetchedContracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
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
% Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
addr) (Contract -> Maybe Contract
forall (a :: OpticKind). a -> Maybe a
Just (ContractCode -> Contract
EVM.initialContract (RuntimeCode -> ContractCode
RuntimeCode (ASCII -> RuntimeCode
ConcreteRuntimeCode ASCII
blob))))
      Bool -> State VM () -> State VM ()
forall (f :: OpticKind -> OpticKind).
Applicative f =>
Bool -> f () -> f ()
when (VM
vm.state.contract Addr -> Addr -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== Addr
addr) (State VM () -> State VM ()) -> State VM () -> State VM ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Addr -> State VM ()
EVM.loadContract Addr
addr
    StorageFact {Addr
W256
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:which:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
which :: W256
..} -> let
        store :: Map W256 (Map W256 W256)
store = VM
vm.cache.fetchedStorage
        ctrct :: Map W256 W256
ctrct = Map W256 W256 -> W256 -> Map W256 (Map W256 W256) -> Map W256 W256
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
a -> k -> Map k a -> a
Map.findWithDefault Map W256 W256
forall (k :: OpticKind) (a :: OpticKind). Map k a
Map.empty (Addr -> W256
forall (target :: OpticKind) (source :: OpticKind).
From source target =>
source -> target
into Addr
addr) Map W256 (Map W256 W256)
store
      in
        VM
vm VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  VM
  VM
  (Map W256 (Map W256 W256))
  (Map W256 (Map W256 W256))
-> Map W256 (Map W256 W256) -> VM -> VM
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 (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens
     NoIx
     Cache
     Cache
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
-> Optic
     A_Lens
     NoIx
     VM
     VM
     (Map W256 (Map W256 W256))
     (Map W256 (Map W256 W256))
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
% Optic
  A_Lens
  NoIx
  Cache
  Cache
  (Map W256 (Map W256 W256))
  (Map W256 (Map W256 W256))
#fetchedStorage) (W256
-> Map W256 W256
-> Map W256 (Map W256 W256)
-> Map W256 (Map W256 W256)
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert (Addr -> W256
forall (target :: OpticKind) (source :: OpticKind).
From source target =>
source -> target
into Addr
addr) (W256 -> W256 -> Map W256 W256 -> Map W256 W256
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
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
..} ->
      VM
vm VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx VM VM W256 W256 -> W256 -> VM -> VM
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 (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic
  A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetchedContracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
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
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
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
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#balance) W256
what
    NonceFact   {Addr
W256
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
..} ->
      VM
vm VM -> (VM -> VM) -> VM
forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx VM VM W256 W256 -> W256 -> VM -> VM
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 (Optic A_Lens NoIx VM VM Cache Cache
#cache Optic A_Lens NoIx VM VM Cache Cache
-> Optic
     A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
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
% Optic
  A_Lens NoIx Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetchedContracts Optic A_Lens NoIx VM VM (Map Addr Contract) (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic
     An_AffineTraversal
     NoIx
     VM
     VM
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
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
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     NoIx
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr Optic
  An_AffineTraversal
  NoIx
  VM
  VM
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     NoIx
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     W256
     W256
-> Optic An_AffineTraversal NoIx VM VM W256 W256
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
% Optic
  A_Lens
  NoIx
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  W256
  W256
#nonce) W256
what

-- Sort facts in the right order for `apply1` to work.
instance Ord Fact where
  compare :: Fact -> Fact -> Ordering
compare = (Fact -> (Int, Addr, W256)) -> Fact -> Fact -> Ordering
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`.
  (VM -> Fact -> VM) -> VM -> Set Fact -> VM
forall (b :: OpticKind) (a :: OpticKind).
(b -> a -> b) -> b -> Set a -> b
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`.
  (VM -> Fact -> VM) -> VM -> Set Fact -> VM
forall (b :: OpticKind) (a :: OpticKind).
(b -> a -> b) -> b -> Set a -> b
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
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
$sel:which:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
which :: W256
..} -> [ASCII] -> ASCII -> W256 -> File
forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk [ASCII
"storage"] (W256 -> ASCII
forall (a :: OpticKind). AsASCII a => a -> ASCII
dump W256
which) W256
what
  BalanceFact {Addr
W256
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
..} -> [ASCII] -> ASCII -> W256 -> File
forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk []          ASCII
"balance"    W256
what
  NonceFact   {Addr
W256
$sel:addr:BalanceFact :: Fact -> Addr
$sel:what:BalanceFact :: Fact -> W256
addr :: Addr
what :: W256
..} -> [ASCII] -> ASCII -> W256 -> File
forall (a :: OpticKind). AsASCII a => [ASCII] -> ASCII -> a -> File
mk []          ASCII
"nonce"      W256
what
  CodeFact    {ASCII
Addr
$sel:addr:BalanceFact :: Fact -> Addr
$sel:blob:BalanceFact :: Fact -> ASCII
addr :: Addr
blob :: ASCII
..} -> [ASCII] -> ASCII -> ASCII -> File
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 (Addr -> ASCII
forall (a :: OpticKind). AsASCII a => a -> ASCII
dump Fact
fact.addr ASCII -> [ASCII] -> [ASCII]
forall (a :: OpticKind). a -> [a] -> [a]
: [ASCII]
prefix) ASCII
base)
           (ASCII -> Data
Data (ASCII -> Data) -> ASCII -> Data
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ a -> ASCII
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))
    -> Fact -> Maybe Fact
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))
    -> Fact -> Maybe Fact
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))
    -> Fact -> Maybe Fact
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))
    -> Fact -> Maybe Fact
forall (a :: OpticKind). a -> Maybe a
Just (Addr -> W256 -> W256 -> Fact
StorageFact Addr
a W256
y W256
x)
  File
_
    -> Maybe Fact
forall (a :: OpticKind). Maybe a
Nothing