diff --git a/src/Zenith/Tree.hs b/src/Zenith/Tree.hs index cc8fe7b..e4b5802 100644 --- a/src/Zenith/Tree.hs +++ b/src/Zenith/Tree.hs @@ -10,7 +10,7 @@ module Zenith.Tree where import Codec.Borsh import Data.HexString -import Data.Int (Int64, Int8) +import Data.Int (Int32, Int64, Int8) import Data.Maybe (fromJust, isNothing) import qualified GHC.Generics as GHC import qualified Generics.SOP as SOP @@ -22,7 +22,7 @@ type Level = Int8 maxLevel :: Level maxLevel = 32 -type Position = Int64 +type Position = Int32 class Monoid v => Measured a v @@ -31,7 +31,7 @@ class Monoid v => class Node v where getLevel :: v -> Level - getTag :: v -> HexString + getHash :: v -> HexString getPosition :: v -> Position isFull :: v -> Bool isMarked :: v -> Bool @@ -60,7 +60,7 @@ instance (Node v, Show v) => Show (Tree v) where show (Leaf v) = "(" ++ show v ++ ")" show (PrunedBranch v) = "{" ++ show v ++ "}" 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" 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 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) 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 level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level -append :: Monoid v => Measured a v => Node v => Tree v -> a -> Int64 -> Tree v -append tree n i = tree <> leaf n p i +append :: Monoid v => Measured a v => Node v => Tree v -> (a, Int64) -> Tree v +append tree (n, i) = tree <> leaf n p i where p = 1 + getPosition (value tree) @@ -133,10 +133,23 @@ mkSubTree level t = where subtree = t <> EmptyLeaf -path :: Position -> Tree v -> Maybe MerklePath -path pos (Branch s x y) = undefined +path :: Monoid v => Node v => Position -> Tree v -> Maybe MerklePath +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 - 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 { on_position :: !Position @@ -171,7 +184,7 @@ instance Monoid OrchardNode where instance Node OrchardNode where getLevel = on_level - getTag = on_value + getHash = on_value getPosition = on_position isFull = on_full isMarked = on_mark @@ -214,4 +227,4 @@ mkOrchardTree tree = case ot_right tree of Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0 Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf - pos = orchardSize tree - 1 + pos = fromIntegral $ orchardSize tree - 1 diff --git a/test/Spec.hs b/test/Spec.hs index d063add..c615c1d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -12,12 +12,13 @@ import qualified Data.Text.Encoding as E import Database.Persist import Database.Persist.Sqlite import System.Directory -import Test.HUnit +import Test.HUnit hiding (State(..)) import Test.Hspec import ZcashHaskell.Orchard ( addOrchardNodeGetRoot , getOrchardFrontier , getOrchardNodeValue + , getOrchardPathAnchor , getOrchardRootTest , getOrchardTreeAnchor , getOrchardTreeParts @@ -38,6 +39,7 @@ import ZcashHaskell.Transparent ) import ZcashHaskell.Types ( DecodedNote(..) + , MerklePath(..) , OrchardCommitmentTree(..) , OrchardFrontier(..) , OrchardSpendingKey(..) @@ -237,16 +239,16 @@ main = do let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode getLevel (value t) `shouldBe` 1 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 "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1 it "Validate empty tree" $ do - getTag (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe` + getHash (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe` getOrchardRootTest 32 it "Validate tree with one leaf" $ do let n = leaf cmx1 0 1 :: Tree OrchardNode 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 let tree = OrchardCommitmentTree $ @@ -289,7 +291,7 @@ main = do let newTree = mkOrchardTree t1 let ctAnchor = getOrchardTreeAnchor tree {- - -getTag (value newTree) `shouldBe` ctAnchor + -getHash (value newTree) `shouldBe` ctAnchor -isFull (value newTree) `shouldBe` False -} getPosition (value newTree) `shouldBe` 39733 @@ -318,12 +320,12 @@ main = do Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkOrchardTree t1 - let updatedTree1 = append newTree cmx1 4 - let updatedTree2 = append updatedTree1 cmx2 5 - let updatedTree3 = append updatedTree2 cmx3 6 - let updatedTree4 = append updatedTree3 cmx4 7 + let updatedTree1 = append newTree (cmx1, 4) + let updatedTree2 = append updatedTree1 (cmx2, 5) + let updatedTree3 = append updatedTree2 (cmx3, 6) + let updatedTree4 = append updatedTree3 (cmx4, 7) let finalAnchor = getOrchardTreeAnchor finalTree - getTag (value updatedTree4) `shouldBe` finalAnchor + getHash (value updatedTree4) `shouldBe` finalAnchor it "Validate serializing tree to bytes" $ do let tree = OrchardCommitmentTree $ @@ -345,6 +347,46 @@ main = do let treeBytes = serialiseBorsh t1 let rebuiltTree = deserialiseBorsh treeBytes 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 "Full" $ do it "To Orchard" $ do