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

-- Collapses a series of puts and gets down to the monad of your choice
runDB :: Monad m
      => (k -> v -> m ()) -- ^ The 'put' function for our desired monad
      -> (k -> m v)       -- ^ The 'get' function for the same monad
      -> DB k v a         -- ^ The puts and gets to execute
      -> 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)

-- the function HP from Appendix C of yellow paper
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