feat: implement merkle path calculator
This commit is contained in:
parent
1898770bf5
commit
a7cf3a75c6
2 changed files with 77 additions and 22 deletions
|
@ -10,7 +10,7 @@ module Zenith.Tree where
|
||||||
|
|
||||||
import Codec.Borsh
|
import Codec.Borsh
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Int (Int64, Int8)
|
import Data.Int (Int32, Int64, Int8)
|
||||||
import Data.Maybe (fromJust, isNothing)
|
import Data.Maybe (fromJust, isNothing)
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
import qualified Generics.SOP as SOP
|
import qualified Generics.SOP as SOP
|
||||||
|
@ -22,7 +22,7 @@ type Level = Int8
|
||||||
maxLevel :: Level
|
maxLevel :: Level
|
||||||
maxLevel = 32
|
maxLevel = 32
|
||||||
|
|
||||||
type Position = Int64
|
type Position = Int32
|
||||||
|
|
||||||
class Monoid v =>
|
class Monoid v =>
|
||||||
Measured a v
|
Measured a v
|
||||||
|
@ -31,7 +31,7 @@ class Monoid v =>
|
||||||
|
|
||||||
class Node v where
|
class Node v where
|
||||||
getLevel :: v -> Level
|
getLevel :: v -> Level
|
||||||
getTag :: v -> HexString
|
getHash :: v -> HexString
|
||||||
getPosition :: v -> Position
|
getPosition :: v -> Position
|
||||||
isFull :: v -> Bool
|
isFull :: v -> Bool
|
||||||
isMarked :: v -> Bool
|
isMarked :: v -> Bool
|
||||||
|
@ -60,7 +60,7 @@ instance (Node v, Show v) => Show (Tree v) where
|
||||||
show (Leaf v) = "(" ++ show v ++ ")"
|
show (Leaf v) = "(" ++ show v ++ ")"
|
||||||
show (PrunedBranch v) = "{" ++ show v ++ "}"
|
show (PrunedBranch v) = "{" ++ show v ++ "}"
|
||||||
show (Branch s x y) =
|
show (Branch s x y) =
|
||||||
"<" ++ show (getTag s) ++ ">\n" ++ show x ++ "\n" ++ show y
|
"<" ++ show (getHash s) ++ ">\n" ++ show x ++ "\n" ++ show y
|
||||||
show InvalidTree = "InvalidTree"
|
show InvalidTree = "InvalidTree"
|
||||||
|
|
||||||
instance (Monoid v, Node v) => Semigroup (Tree v) where
|
instance (Monoid v, Node v) => Semigroup (Tree v) where
|
||||||
|
@ -105,7 +105,7 @@ value InvalidTree = mempty
|
||||||
branch :: Monoid v => Tree v -> Tree v -> Tree v
|
branch :: Monoid v => Tree v -> Tree v -> Tree v
|
||||||
branch x y = Branch (value x <> value y) x y
|
branch x y = Branch (value x <> value y) x y
|
||||||
|
|
||||||
leaf :: Measured a v => a -> Int64 -> Int64 -> Tree v
|
leaf :: Measured a v => a -> Int32 -> Int64 -> Tree v
|
||||||
leaf a p i = Leaf (measure a p i)
|
leaf a p i = Leaf (measure a p i)
|
||||||
|
|
||||||
prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v
|
prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v
|
||||||
|
@ -120,8 +120,8 @@ root tree =
|
||||||
getEmptyRoot :: Monoid v => Node v => Level -> Tree v
|
getEmptyRoot :: Monoid v => Node v => Level -> Tree v
|
||||||
getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level
|
getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level
|
||||||
|
|
||||||
append :: Monoid v => Measured a v => Node v => Tree v -> a -> Int64 -> Tree v
|
append :: Monoid v => Measured a v => Node v => Tree v -> (a, Int64) -> Tree v
|
||||||
append tree n i = tree <> leaf n p i
|
append tree (n, i) = tree <> leaf n p i
|
||||||
where
|
where
|
||||||
p = 1 + getPosition (value tree)
|
p = 1 + getPosition (value tree)
|
||||||
|
|
||||||
|
@ -133,10 +133,23 @@ mkSubTree level t =
|
||||||
where
|
where
|
||||||
subtree = t <> EmptyLeaf
|
subtree = t <> EmptyLeaf
|
||||||
|
|
||||||
path :: Position -> Tree v -> Maybe MerklePath
|
path :: Monoid v => Node v => Position -> Tree v -> Maybe MerklePath
|
||||||
path pos (Branch s x y) = undefined
|
path pos (Branch s x y) =
|
||||||
|
if length (collectPath (Branch s x y)) /= 32
|
||||||
|
then Nothing
|
||||||
|
else Just $ MerklePath pos $ collectPath (Branch s x y)
|
||||||
where
|
where
|
||||||
collectPath t = undefined
|
collectPath :: Monoid v => Node v => Tree v -> [HexString]
|
||||||
|
collectPath EmptyLeaf = []
|
||||||
|
collectPath Leaf {} = []
|
||||||
|
collectPath PrunedBranch {} = []
|
||||||
|
collectPath InvalidTree = []
|
||||||
|
collectPath (Branch _ j k)
|
||||||
|
| getPosition (value k) /= 0 && getPosition (value k) < pos = []
|
||||||
|
| getPosition (value j) < pos = collectPath k <> [getHash (value j)]
|
||||||
|
| getPosition (value j) >= pos = collectPath j <> [getHash (value k)]
|
||||||
|
| otherwise = []
|
||||||
|
path _ _ = Nothing
|
||||||
|
|
||||||
data OrchardNode = OrchardNode
|
data OrchardNode = OrchardNode
|
||||||
{ on_position :: !Position
|
{ on_position :: !Position
|
||||||
|
@ -171,7 +184,7 @@ instance Monoid OrchardNode where
|
||||||
|
|
||||||
instance Node OrchardNode where
|
instance Node OrchardNode where
|
||||||
getLevel = on_level
|
getLevel = on_level
|
||||||
getTag = on_value
|
getHash = on_value
|
||||||
getPosition = on_position
|
getPosition = on_position
|
||||||
isFull = on_full
|
isFull = on_full
|
||||||
isMarked = on_mark
|
isMarked = on_mark
|
||||||
|
@ -214,4 +227,4 @@ mkOrchardTree tree =
|
||||||
case ot_right tree of
|
case ot_right tree of
|
||||||
Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0
|
Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0
|
||||||
Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf
|
Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf
|
||||||
pos = orchardSize tree - 1
|
pos = fromIntegral $ orchardSize tree - 1
|
||||||
|
|
62
test/Spec.hs
62
test/Spec.hs
|
@ -12,12 +12,13 @@ import qualified Data.Text.Encoding as E
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Test.HUnit
|
import Test.HUnit hiding (State(..))
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import ZcashHaskell.Orchard
|
import ZcashHaskell.Orchard
|
||||||
( addOrchardNodeGetRoot
|
( addOrchardNodeGetRoot
|
||||||
, getOrchardFrontier
|
, getOrchardFrontier
|
||||||
, getOrchardNodeValue
|
, getOrchardNodeValue
|
||||||
|
, getOrchardPathAnchor
|
||||||
, getOrchardRootTest
|
, getOrchardRootTest
|
||||||
, getOrchardTreeAnchor
|
, getOrchardTreeAnchor
|
||||||
, getOrchardTreeParts
|
, getOrchardTreeParts
|
||||||
|
@ -38,6 +39,7 @@ import ZcashHaskell.Transparent
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( DecodedNote(..)
|
( DecodedNote(..)
|
||||||
|
, MerklePath(..)
|
||||||
, OrchardCommitmentTree(..)
|
, OrchardCommitmentTree(..)
|
||||||
, OrchardFrontier(..)
|
, OrchardFrontier(..)
|
||||||
, OrchardSpendingKey(..)
|
, OrchardSpendingKey(..)
|
||||||
|
@ -237,16 +239,16 @@ main = do
|
||||||
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode
|
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode
|
||||||
getLevel (value t) `shouldBe` 1
|
getLevel (value t) `shouldBe` 1
|
||||||
it "Create minimal empty tree" $ do
|
it "Create minimal empty tree" $ do
|
||||||
getTag (value t0) `shouldNotBe` hexString "00"
|
getHash (value t0) `shouldNotBe` hexString "00"
|
||||||
it "Expand empty tree" $ do t1 `shouldBe` t1a
|
it "Expand empty tree" $ do t1 `shouldBe` t1a
|
||||||
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
|
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
|
||||||
it "Validate empty tree" $ do
|
it "Validate empty tree" $ do
|
||||||
getTag (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe`
|
getHash (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe`
|
||||||
getOrchardRootTest 32
|
getOrchardRootTest 32
|
||||||
it "Validate tree with one leaf" $ do
|
it "Validate tree with one leaf" $ do
|
||||||
let n = leaf cmx1 0 1 :: Tree OrchardNode
|
let n = leaf cmx1 0 1 :: Tree OrchardNode
|
||||||
let n1 = root n
|
let n1 = root n
|
||||||
getTag (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1)
|
getHash (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1)
|
||||||
it "Validate size of tree from Zebra" $ do
|
it "Validate size of tree from Zebra" $ do
|
||||||
let tree =
|
let tree =
|
||||||
OrchardCommitmentTree $
|
OrchardCommitmentTree $
|
||||||
|
@ -289,7 +291,7 @@ main = do
|
||||||
let newTree = mkOrchardTree t1
|
let newTree = mkOrchardTree t1
|
||||||
let ctAnchor = getOrchardTreeAnchor tree
|
let ctAnchor = getOrchardTreeAnchor tree
|
||||||
{-
|
{-
|
||||||
-getTag (value newTree) `shouldBe` ctAnchor
|
-getHash (value newTree) `shouldBe` ctAnchor
|
||||||
-isFull (value newTree) `shouldBe` False
|
-isFull (value newTree) `shouldBe` False
|
||||||
-}
|
-}
|
||||||
getPosition (value newTree) `shouldBe` 39733
|
getPosition (value newTree) `shouldBe` 39733
|
||||||
|
@ -318,12 +320,12 @@ main = do
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
Just t1 -> do
|
Just t1 -> do
|
||||||
let newTree = mkOrchardTree t1
|
let newTree = mkOrchardTree t1
|
||||||
let updatedTree1 = append newTree cmx1 4
|
let updatedTree1 = append newTree (cmx1, 4)
|
||||||
let updatedTree2 = append updatedTree1 cmx2 5
|
let updatedTree2 = append updatedTree1 (cmx2, 5)
|
||||||
let updatedTree3 = append updatedTree2 cmx3 6
|
let updatedTree3 = append updatedTree2 (cmx3, 6)
|
||||||
let updatedTree4 = append updatedTree3 cmx4 7
|
let updatedTree4 = append updatedTree3 (cmx4, 7)
|
||||||
let finalAnchor = getOrchardTreeAnchor finalTree
|
let finalAnchor = getOrchardTreeAnchor finalTree
|
||||||
getTag (value updatedTree4) `shouldBe` finalAnchor
|
getHash (value updatedTree4) `shouldBe` finalAnchor
|
||||||
it "Validate serializing tree to bytes" $ do
|
it "Validate serializing tree to bytes" $ do
|
||||||
let tree =
|
let tree =
|
||||||
OrchardCommitmentTree $
|
OrchardCommitmentTree $
|
||||||
|
@ -345,6 +347,46 @@ main = do
|
||||||
let treeBytes = serialiseBorsh t1
|
let treeBytes = serialiseBorsh t1
|
||||||
let rebuiltTree = deserialiseBorsh treeBytes
|
let rebuiltTree = deserialiseBorsh treeBytes
|
||||||
rebuiltTree `shouldBe` Right t1
|
rebuiltTree `shouldBe` Right t1
|
||||||
|
it "Create merkle path" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
|
case path 39735 updatedTree of
|
||||||
|
Nothing -> assertFailure "Failed to get Merkle path"
|
||||||
|
Just p1 -> p1 `shouldNotBe` MerklePath 0 []
|
||||||
|
it "Validate merkle path" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
|
case path 39735 updatedTree of
|
||||||
|
Nothing -> assertFailure "Failed to get Merkle path"
|
||||||
|
Just p1 -> do
|
||||||
|
getOrchardPathAnchor cmx2 p1 `shouldBe`
|
||||||
|
getHash (value updatedTree)
|
||||||
describe "Creating Tx" $ do
|
describe "Creating Tx" $ do
|
||||||
describe "Full" $ do
|
describe "Full" $ do
|
||||||
it "To Orchard" $ do
|
it "To Orchard" $ do
|
||||||
|
|
Loading…
Reference in a new issue