module EVM.Patricia where
import EVM.RLP
import EVM.Types
import Control.Monad.Free
import Control.Monad.State
import Data.ByteString (ByteString)
import Data.Foldable (toList)
import Data.List (stripPrefix)
import Data.Sequence (Seq)
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
data KV k v a
= Put k v a
| Get k (v -> a)
deriving (forall a b. a -> KV k v b -> KV k v a
forall a b. (a -> b) -> KV k v a -> KV k v b
forall k v a b. a -> KV k v b -> KV k v a
forall k v a b. (a -> b) -> KV k v a -> KV k v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> KV k v b -> KV k v a
$c<$ :: forall k v a b. a -> KV k v b -> KV k v a
fmap :: forall a b. (a -> b) -> KV k v a -> KV k v b
$cfmap :: forall k v a b. (a -> b) -> KV k v a -> KV k v b
Functor)
newtype DB k v a = DB (Free (KV k v) a)
deriving (forall a b. a -> DB k v b -> DB k v a
forall a b. (a -> b) -> DB k v a -> DB k v b
forall k v a b. a -> DB k v b -> DB k v a
forall k v a b. (a -> b) -> DB k v a -> DB k v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DB k v b -> DB k v a
$c<$ :: forall k v a b. a -> DB k v b -> DB k v a
fmap :: forall a b. (a -> b) -> DB k v a -> DB k v b
$cfmap :: forall k v a b. (a -> b) -> DB k v a -> DB k v b
Functor, forall a. a -> DB k v a
forall k v. Functor (DB k v)
forall a b. DB k v a -> DB k v b -> DB k v a
forall a b. DB k v a -> DB k v b -> DB k v b
forall a b. DB k v (a -> b) -> DB k v a -> DB k v b
forall k v a. a -> DB k v a
forall a b c. (a -> b -> c) -> DB k v a -> DB k v b -> DB k v c
forall k v a b. DB k v a -> DB k v b -> DB k v a
forall k v a b. DB k v a -> DB k v b -> DB k v b
forall k v a b. DB k v (a -> b) -> DB k v a -> DB k v b
forall k v a b c. (a -> b -> c) -> DB k v a -> DB k v b -> DB k v c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. DB k v a -> DB k v b -> DB k v a
$c<* :: forall k v a b. DB k v a -> DB k v b -> DB k v a
*> :: forall a b. DB k v a -> DB k v b -> DB k v b
$c*> :: forall k v a b. DB k v a -> DB k v b -> DB k v b
liftA2 :: forall a b c. (a -> b -> c) -> DB k v a -> DB k v b -> DB k v c
$cliftA2 :: forall k v a b c. (a -> b -> c) -> DB k v a -> DB k v b -> DB k v c
<*> :: forall a b. DB k v (a -> b) -> DB k v a -> DB k v b
$c<*> :: forall k v a b. DB k v (a -> b) -> DB k v a -> DB k v b
pure :: forall a. a -> DB k v a
$cpure :: forall k v a. a -> DB k v a
Applicative, forall a. a -> DB k v a
forall k v. Applicative (DB k v)
forall a b. DB k v a -> DB k v b -> DB k v b
forall a b. DB k v a -> (a -> DB k v b) -> DB k v b
forall k v a. a -> DB k v a
forall k v a b. DB k v a -> DB k v b -> DB k v b
forall k v a b. DB k v a -> (a -> DB k v b) -> DB k v b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> DB k v a
$creturn :: forall k v a. a -> DB k v a
>> :: forall a b. DB k v a -> DB k v b -> DB k v b
$c>> :: forall k v a b. DB k v a -> DB k v b -> DB k v b
>>= :: forall a b. DB k v a -> (a -> DB k v b) -> DB k v b
$c>>= :: forall k v a b. DB k v a -> (a -> DB k v b) -> DB k v b
Monad)
insertDB :: k -> v -> DB k v ()
insertDB :: forall k v. k -> v -> DB k v ()
insertDB k
k v
v = forall k v a. Free (KV k v) a -> DB k v a
DB forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF forall a b. (a -> b) -> a -> b
$ forall k v a. k -> v -> a -> KV k v a
Put k
k v
v ()
lookupDB :: k -> DB k v v
lookupDB :: forall k v. k -> DB k v v
lookupDB k
k = forall k v a. Free (KV k v) a -> DB k v a
DB forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF forall a b. (a -> b) -> a -> b
$ forall k v a. k -> (v -> a) -> KV k v a
Get k
k forall a. a -> a
id
runDB :: Monad m
=> (k -> v -> m ())
-> (k -> m v)
-> DB k v a
-> m a
runDB :: forall (m :: * -> *) k v a.
Monad m =>
(k -> v -> m ()) -> (k -> m v) -> DB k v a -> m a
runDB k -> v -> m ()
putt k -> m v
gett (DB Free (KV k v) a
ops) = Free (KV k v) a -> m a
go Free (KV k v) a
ops
where
go :: Free (KV k v) a -> m a
go (Pure a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
go (Free (Put k
k v
v Free (KV k v) a
next)) = k -> v -> m ()
putt k
k v
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Free (KV k v) a -> m a
go Free (KV k v) a
next
go (Free (Get k
k v -> Free (KV k v) a
handler)) = k -> m v
gett k
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Free (KV k v) a -> m a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Free (KV k v) a
handler
type Path = [Nibble]
data Ref = Hash ByteString | Literal Node
deriving (Ref -> Ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ref -> Ref -> Bool
$c/= :: Ref -> Ref -> Bool
== :: Ref -> Ref -> Bool
$c== :: Ref -> Ref -> Bool
Eq)
instance Show Ref where
show :: Ref -> String
show (Hash ByteString
d) = forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
d)
show (Literal Node
n) = forall a. Show a => a -> String
show Node
n
data Node = Empty
| Shortcut Path (Either Ref ByteString)
| Full (Seq Ref) ByteString
deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq)
encodePath :: Path -> Bool -> ByteString
encodePath :: Path -> Bool -> ByteString
encodePath Path
p Bool
isTerminal | forall a. Integral a => a -> Bool
even (forall (t :: * -> *) a. Foldable t => t a -> Int
length Path
p)
= Path -> ByteString
packNibbles forall a b. (a -> b) -> a -> b
$ Word8 -> Nibble
Nibble Word8
flag forall a. a -> [a] -> [a]
: Word8 -> Nibble
Nibble Word8
0 forall a. a -> [a] -> [a]
: Path
p
| Bool
otherwise
= Path -> ByteString
packNibbles forall a b. (a -> b) -> a -> b
$ Word8 -> Nibble
Nibble (Word8
flag forall a. Num a => a -> a -> a
+ Word8
1) forall a. a -> [a] -> [a]
: Path
p
where flag :: Word8
flag = if Bool
isTerminal then Word8
2 else Word8
0
rlpRef :: Ref -> RLP
rlpRef :: Ref -> RLP
rlpRef (Hash ByteString
d) = ByteString -> RLP
BS ByteString
d
rlpRef (Literal Node
n) = Node -> RLP
rlpNode Node
n
rlpNode :: Node -> RLP
rlpNode :: Node -> RLP
rlpNode Node
Empty = ByteString -> RLP
BS forall a. Monoid a => a
mempty
rlpNode (Shortcut Path
path (Right ByteString
val)) = [RLP] -> RLP
List [ByteString -> RLP
BS forall a b. (a -> b) -> a -> b
$ Path -> Bool -> ByteString
encodePath Path
path Bool
True, ByteString -> RLP
BS ByteString
val]
rlpNode (Shortcut Path
path (Left Ref
ref)) = [RLP] -> RLP
List [ByteString -> RLP
BS forall a b. (a -> b) -> a -> b
$ Path -> Bool -> ByteString
encodePath Path
path Bool
False, Ref -> RLP
rlpRef Ref
ref]
rlpNode (Full Seq Ref
refs ByteString
val) = [RLP] -> RLP
List forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref -> RLP
rlpRef Seq Ref
refs) forall a. Semigroup a => a -> a -> a
<> [ByteString -> RLP
BS ByteString
val]
type NodeDB = DB ByteString Node
instance Show (NodeDB Node) where
show :: NodeDB Node -> String
show = forall a. Show a => a -> String
show
putNode :: Node -> NodeDB Ref
putNode :: Node -> NodeDB Ref
putNode Node
node =
let bytes :: ByteString
bytes = RLP -> ByteString
rlpencode forall a b. (a -> b) -> a -> b
$ Node -> RLP
rlpNode Node
node
digest :: ByteString
digest = W256 -> ByteString
word256Bytes forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' ByteString
bytes
in if ByteString -> Int
BS.length ByteString
bytes forall a. Ord a => a -> a -> Bool
< Int
32
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Node -> Ref
Literal Node
node
else do
forall k v. k -> v -> DB k v ()
insertDB ByteString
digest Node
node
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Ref
Hash ByteString
digest
getNode :: Ref -> NodeDB Node
getNode :: Ref -> NodeDB Node
getNode (Hash ByteString
d) = forall k v. k -> DB k v v
lookupDB ByteString
d
getNode (Literal Node
n) = forall (m :: * -> *) a. Monad m => a -> m a
return Node
n
lookupPath :: Ref -> Path -> NodeDB ByteString
lookupPath :: Ref -> Path -> NodeDB ByteString
lookupPath Ref
root Path
path = Ref -> NodeDB Node
getNode Ref
root forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Node -> NodeDB ByteString
getVal Path
path
getVal :: Path -> Node -> NodeDB ByteString
getVal :: Path -> Node -> NodeDB ByteString
getVal Path
_ Node
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BS.empty
getVal Path
path (Shortcut Path
nodePath Either Ref ByteString
ref) =
case (forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix Path
nodePath Path
path, Either Ref ByteString
ref) of
(Just [], Right ByteString
value) -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
value
(Just Path
remaining, Left Ref
key) -> Ref -> Path -> NodeDB ByteString
lookupPath Ref
key Path
remaining
(Maybe Path, Either Ref ByteString)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BS.empty
getVal [] (Full Seq Ref
_ ByteString
val) = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
val
getVal (Nibble
p:Path
ps) (Full Seq Ref
refs ByteString
_) = Ref -> Path -> NodeDB ByteString
lookupPath (Seq Ref
refs forall a. Seq a -> Int -> a
`Seq.index` (forall a b. (Integral a, Num b) => a -> b
num Nibble
p)) Path
ps
emptyRef :: Ref
emptyRef :: Ref
emptyRef = Node -> Ref
Literal Node
Empty
emptyRefs :: Seq Ref
emptyRefs :: Seq Ref
emptyRefs = forall a. Int -> a -> Seq a
Seq.replicate Int
16 Ref
emptyRef
addPrefix :: Path -> Node -> NodeDB Node
addPrefix :: Path -> Node -> NodeDB Node
addPrefix Path
_ Node
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return Node
Empty
addPrefix [] Node
node = forall (m :: * -> *) a. Monad m => a -> m a
return Node
node
addPrefix Path
path (Shortcut Path
p Either Ref ByteString
v) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Path -> Either Ref ByteString -> Node
Shortcut (Path
path forall a. Semigroup a => a -> a -> a
<> Path
p) Either Ref ByteString
v
addPrefix Path
path Node
n = Path -> Either Ref ByteString -> Node
Shortcut Path
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node -> NodeDB Ref
putNode Node
n
insertRef :: Ref -> Path -> ByteString -> NodeDB Ref
insertRef :: Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
ref Path
p ByteString
val = do Node
root <- Ref -> NodeDB Node
getNode Ref
ref
Node
newNode <- if ByteString
val forall a. Eq a => a -> a -> Bool
== ByteString
BS.empty
then Node -> Path -> NodeDB Node
delete Node
root Path
p
else Node -> Path -> ByteString -> NodeDB Node
update Node
root Path
p ByteString
val
Node -> NodeDB Ref
putNode Node
newNode
update :: Node -> Path -> ByteString -> NodeDB Node
update :: Node -> Path -> ByteString -> NodeDB Node
update Node
Empty Path
p ByteString
new = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Path -> Either Ref ByteString -> Node
Shortcut Path
p (forall a b. b -> Either a b
Right ByteString
new)
update (Full Seq Ref
refs ByteString
_) [] ByteString
new = forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Ref -> ByteString -> Node
Full Seq Ref
refs ByteString
new)
update (Full Seq Ref
refs ByteString
old) (Nibble
p:Path
ps) ByteString
new = do
Ref
newRef <- Ref -> Path -> ByteString -> NodeDB Ref
insertRef (Seq Ref
refs forall a. Seq a -> Int -> a
`Seq.index` (forall a b. (Integral a, Num b) => a -> b
num Nibble
p)) Path
ps ByteString
new
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Seq Ref -> ByteString -> Node
Full (forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
p) Ref
newRef Seq Ref
refs) ByteString
old
update (Shortcut (Nibble
o:Path
os) (Right ByteString
old)) [] ByteString
new = do
Ref
newRef <- Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
emptyRef Path
os ByteString
old
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Seq Ref -> ByteString -> Node
Full (forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
o) Ref
newRef Seq Ref
emptyRefs) ByteString
new
update (Shortcut [] (Right ByteString
old)) (Nibble
p:Path
ps) ByteString
new = do
Ref
newRef <- Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
emptyRef Path
ps ByteString
new
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Seq Ref -> ByteString -> Node
Full (forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
p) Ref
newRef Seq Ref
emptyRefs) ByteString
old
update (Shortcut [] (Right ByteString
_)) [] ByteString
new =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Path -> Either Ref ByteString -> Node
Shortcut [] (forall a b. b -> Either a b
Right ByteString
new)
update (Shortcut (Nibble
o:Path
os) Either Ref ByteString
to) (Nibble
p:Path
ps) ByteString
new | Nibble
o forall a. Eq a => a -> a -> Bool
== Nibble
p
= Node -> Path -> ByteString -> NodeDB Node
update (Path -> Either Ref ByteString -> Node
Shortcut Path
os Either Ref ByteString
to) Path
ps ByteString
new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Node -> NodeDB Node
addPrefix [Nibble
o]
| Bool
otherwise = do
Ref
oldRef <- case Either Ref ByteString
to of
(Left Ref
ref) -> Ref -> NodeDB Node
getNode Ref
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Node -> NodeDB Node
addPrefix Path
os forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node -> NodeDB Ref
putNode
(Right ByteString
val) -> Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
emptyRef Path
os ByteString
val
Ref
newRef <- Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
emptyRef Path
ps ByteString
new
let refs :: Seq Ref
refs = forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
p) Ref
newRef forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
o) Ref
oldRef Seq Ref
emptyRefs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Seq Ref -> ByteString -> Node
Full Seq Ref
refs ByteString
BS.empty
update (Shortcut (Nibble
o:Path
os) (Left Ref
ref)) [] ByteString
new = do
Ref
newRef <- Ref -> NodeDB Node
getNode Ref
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Node -> NodeDB Node
addPrefix Path
os forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node -> NodeDB Ref
putNode
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Seq Ref -> ByteString -> Node
Full (forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
o) Ref
newRef Seq Ref
emptyRefs) ByteString
new
update (Shortcut Path
cut (Left Ref
ref)) Path
ps ByteString
new = do
Ref
newRef <- Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
ref Path
ps ByteString
new
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Path -> Either Ref ByteString -> Node
Shortcut Path
cut (forall a b. a -> Either a b
Left Ref
newRef)
delete :: Node -> Path -> NodeDB Node
delete :: Node -> Path -> NodeDB Node
delete Node
Empty Path
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Node
Empty
delete (Shortcut [] (Right ByteString
_)) [] = forall (m :: * -> *) a. Monad m => a -> m a
return Node
Empty
delete n :: Node
n@(Shortcut [] (Right ByteString
_)) Path
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Node
n
delete (Shortcut [] (Left Ref
ref)) Path
p = do Node
node <- Ref -> NodeDB Node
getNode Ref
ref
Node -> Path -> NodeDB Node
delete Node
node Path
p
delete n :: Node
n@(Shortcut Path
_ Either Ref ByteString
_) [] = forall (m :: * -> *) a. Monad m => a -> m a
return Node
n
delete n :: Node
n@(Shortcut (Nibble
o:Path
os) Either Ref ByteString
to) (Nibble
p:Path
ps) | Nibble
p forall a. Eq a => a -> a -> Bool
== Nibble
o
= Node -> Path -> NodeDB Node
delete (Path -> Either Ref ByteString -> Node
Shortcut Path
os Either Ref ByteString
to) Path
ps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Node -> NodeDB Node
addPrefix [Nibble
o]
| Bool
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return Node
n
delete (Full Seq Ref
refs ByteString
_) [] | Seq Ref
refs forall a. Eq a => a -> a -> Bool
== Seq Ref
emptyRefs
= forall (m :: * -> *) a. Monad m => a -> m a
return Node
Empty
| Bool
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Ref -> ByteString -> Node
Full Seq Ref
refs ByteString
BS.empty)
delete (Full Seq Ref
refs ByteString
val) (Nibble
p:Path
ps) = do
Ref
newRef <- Ref -> Path -> ByteString -> NodeDB Ref
insertRef (Seq Ref
refs forall a. Seq a -> Int -> a
`Seq.index` (forall a b. (Integral a, Num b) => a -> b
num Nibble
p)) Path
ps ByteString
BS.empty
let newRefs :: Seq Ref
newRefs = forall a. Int -> a -> Seq a -> Seq a
Seq.update (forall a b. (Integral a, Num b) => a -> b
num Nibble
p) Ref
newRef Seq Ref
refs
nonEmpties :: [(Word8, Ref)]
nonEmpties = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Word8
_, Ref
ref) -> Ref
ref forall a. Eq a => a -> a -> Bool
/= Ref
emptyRef) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
0..Word8
15] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Ref
newRefs
case ([(Word8, Ref)]
nonEmpties, ByteString -> Bool
BS.null ByteString
val) of
([], Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return Node
Empty
([(Word8
n, Ref
ref)], Bool
True) -> Ref -> NodeDB Node
getNode Ref
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> Node -> NodeDB Node
addPrefix [Word8 -> Nibble
Nibble Word8
n]
([(Word8, Ref)], Bool)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Seq Ref -> ByteString -> Node
Full Seq Ref
newRefs ByteString
val
insert :: Ref -> ByteString -> ByteString -> NodeDB Ref
insert :: Ref -> ByteString -> ByteString -> NodeDB Ref
insert Ref
ref ByteString
key = Ref -> Path -> ByteString -> NodeDB Ref
insertRef Ref
ref (ByteString -> Path
unpackNibbles ByteString
key)
lookupIn :: Ref -> ByteString -> NodeDB ByteString
lookupIn :: Ref -> ByteString -> NodeDB ByteString
lookupIn Ref
ref ByteString
bs = Ref -> Path -> NodeDB ByteString
lookupPath Ref
ref forall a b. (a -> b) -> a -> b
$ ByteString -> Path
unpackNibbles ByteString
bs
type Trie = StateT Ref NodeDB
runTrie :: DB ByteString ByteString a -> Trie a
runTrie :: forall a. DB ByteString ByteString a -> Trie a
runTrie = forall (m :: * -> *) k v a.
Monad m =>
(k -> v -> m ()) -> (k -> m v) -> DB k v a -> m a
runDB forall {t :: (* -> *) -> * -> *}.
(MonadState Ref (t (DB ByteString Node)), MonadTrans t) =>
ByteString -> ByteString -> t (DB ByteString Node) ()
putDB forall {t :: (* -> *) -> * -> *}.
(MonadState Ref (t (DB ByteString Node)), MonadTrans t) =>
ByteString -> t (DB ByteString Node) ByteString
getDB
where
putDB :: ByteString -> ByteString -> t (DB ByteString Node) ()
putDB ByteString
key ByteString
val = do
Ref
ref <- forall s (m :: * -> *). MonadState s m => m s
get
Ref
newRef <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Ref -> ByteString -> ByteString -> NodeDB Ref
insert Ref
ref ByteString
key ByteString
val
forall s (m :: * -> *). MonadState s m => s -> m ()
put Ref
newRef
getDB :: ByteString -> t (DB ByteString Node) ByteString
getDB ByteString
key = do
Ref
ref <- forall s (m :: * -> *). MonadState s m => m s
get
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Ref -> ByteString -> NodeDB ByteString
lookupIn Ref
ref ByteString
key
type MapDB k v a = StateT (Map.Map k v) Maybe a
runMapDB :: Ord k => DB k v a -> MapDB k v a
runMapDB :: forall k v a. Ord k => DB k v a -> MapDB k v a
runMapDB = forall (m :: * -> *) k v a.
Monad m =>
(k -> v -> m ()) -> (k -> m v) -> DB k v a -> m a
runDB forall {m :: * -> *} {k} {a}.
(MonadState (Map k a) m, Ord k) =>
k -> a -> m ()
putDB forall {t :: (* -> *) -> * -> *} {k} {b}.
(MonadState (Map k b) (t Maybe), MonadTrans t, Ord k) =>
k -> t Maybe b
getDB
where
getDB :: k -> t Maybe b
getDB k
key = do
Map k b
mmap <- forall s (m :: * -> *). MonadState s m => m s
get
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k b
mmap
putDB :: k -> a -> m ()
putDB k
key a
value = do
Map k a
mmap <- forall s (m :: * -> *). MonadState s m => m s
get
let newMap :: Map k a
newMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
key a
value Map k a
mmap
forall s (m :: * -> *). MonadState s m => s -> m ()
put Map k a
newMap
insertValues :: [(ByteString, ByteString)] -> Maybe Ref
insertValues :: [(ByteString, ByteString)] -> Maybe Ref
insertValues [(ByteString, ByteString)]
inputs =
let trie :: Trie ()
trie = forall a. DB ByteString ByteString a -> Trie a
runTrie forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {k} {v}. (k, v) -> DB k v ()
insertPair [(ByteString, ByteString)]
inputs
mapDB :: MapDB ByteString Node ((), Ref)
mapDB = forall k v a. Ord k => DB k v a -> MapDB k v a
runMapDB forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Trie ()
trie (Node -> Ref
Literal Node
Empty)
result :: Maybe Ref
result = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT MapDB ByteString Node ((), Ref)
mapDB forall k a. Map k a
Map.empty
insertPair :: (k, v) -> DB k v ()
insertPair (k
key, v
value) = forall k v. k -> v -> DB k v ()
insertDB k
key v
value
in Maybe Ref
result
calcRoot :: [(ByteString, ByteString)] -> Maybe ByteString
calcRoot :: [(ByteString, ByteString)] -> Maybe ByteString
calcRoot [(ByteString, ByteString)]
vs = case [(ByteString, ByteString)] -> Maybe Ref
insertValues [(ByteString, ByteString)]
vs of
Just (Hash ByteString
b) -> forall a. a -> Maybe a
Just ByteString
b
Just (Literal Node
n) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ W256 -> ByteString
word256Bytes forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' forall a b. (a -> b) -> a -> b
$ RLP -> ByteString
rlpencode forall a b. (a -> b) -> a -> b
$ Node -> RLP
rlpNode Node
n
Maybe Ref
Nothing -> forall a. Maybe a
Nothing