diff --git a/src/Zenith/Tree.hs b/src/Zenith/Tree.hs new file mode 100644 index 0000000..e4b5802 --- /dev/null +++ b/src/Zenith/Tree.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE UndecidableInstances #-} + +module Zenith.Tree where + +import Codec.Borsh +import Data.HexString +import Data.Int (Int32, Int64, Int8) +import Data.Maybe (fromJust, isNothing) +import qualified GHC.Generics as GHC +import qualified Generics.SOP as SOP +import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue) +import ZcashHaskell.Types (MerklePath(..), OrchardFrontier(..), OrchardTree(..)) + +type Level = Int8 + +maxLevel :: Level +maxLevel = 32 + +type Position = Int32 + +class Monoid v => + Measured a v + where + measure :: a -> Position -> Int64 -> v + +class Node v where + getLevel :: v -> Level + getHash :: v -> HexString + getPosition :: v -> Position + isFull :: v -> Bool + isMarked :: v -> Bool + mkNode :: Level -> Position -> HexString -> v + +type OrchardCommitment = HexString + +instance Measured OrchardCommitment OrchardNode where + measure oc p i = + case getOrchardNodeValue (hexBytes oc) of + Nothing -> OrchardNode 0 (hexString "00") 0 True 0 False + Just val -> OrchardNode p val 0 True i False + +data Tree v + = EmptyLeaf + | Leaf !v + | PrunedBranch !v + | Branch !v !(Tree v) !(Tree v) + | InvalidTree + deriving stock (Eq, GHC.Generic) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving (BorshSize, ToBorsh, FromBorsh) via AsEnum (Tree v) + +instance (Node v, Show v) => Show (Tree v) where + show EmptyLeaf = "()" + show (Leaf v) = "(" ++ show v ++ ")" + show (PrunedBranch v) = "{" ++ show v ++ "}" + show (Branch s x y) = + "<" ++ show (getHash s) ++ ">\n" ++ show x ++ "\n" ++ show y + show InvalidTree = "InvalidTree" + +instance (Monoid v, Node v) => Semigroup (Tree v) where + (<>) InvalidTree _ = InvalidTree + (<>) _ InvalidTree = InvalidTree + (<>) EmptyLeaf EmptyLeaf = PrunedBranch $ value $ branch EmptyLeaf EmptyLeaf + (<>) EmptyLeaf x = x + (<>) (Leaf x) EmptyLeaf = branch (Leaf x) EmptyLeaf + (<>) (Leaf x) (Leaf y) = branch (Leaf x) (Leaf y) + (<>) (Leaf _) Branch {} = InvalidTree + (<>) (Leaf _) (PrunedBranch _) = InvalidTree + (<>) (PrunedBranch x) EmptyLeaf = PrunedBranch $ x <> x + (<>) (PrunedBranch x) (Leaf y) = + if isFull x + then InvalidTree + else mkSubTree (getLevel x) (Leaf y) + (<>) (PrunedBranch x) (Branch s t u) = + if getLevel x == getLevel s + then branch (PrunedBranch x) (Branch s t u) + else InvalidTree + (<>) (PrunedBranch x) (PrunedBranch y) = PrunedBranch $ x <> y + (<>) (Branch s x y) EmptyLeaf = + branch (Branch s x y) $ getEmptyRoot (getLevel s) + (<>) (Branch s x y) (PrunedBranch w) + | getLevel s == getLevel w = branch (Branch s x y) (PrunedBranch w) + | otherwise = InvalidTree + (<>) (Branch s x y) (Leaf w) + | isFull s = Branch s x y <> mkSubTree (getLevel s) (Leaf w) + | isFull (value x) = branch x (y <> Leaf w) + | otherwise = branch (x <> Leaf w) y + (<>) (Branch s x y) (Branch s1 x1 y1) + | getLevel s == getLevel s1 = branch (Branch s x y) (Branch s1 x1 y1) + | otherwise = InvalidTree + +value :: Monoid v => Tree v -> v +value EmptyLeaf = mempty +value (Leaf v) = v +value (PrunedBranch v) = v +value (Branch v _ _) = v +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 -> Int32 -> Int64 -> Tree v +leaf a p i = Leaf (measure a p i) + +prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v +prunedBranch level pos val = PrunedBranch $ mkNode level pos val + +root :: Monoid v => Node v => Tree v -> Tree v +root tree = + if getLevel (value tree) == maxLevel + then tree + else mkSubTree maxLevel 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 + where + p = 1 + getPosition (value tree) + +mkSubTree :: Node v => Monoid v => Level -> Tree v -> Tree v +mkSubTree level t = + if getLevel (value subtree) == level + then subtree + else mkSubTree level subtree + where + subtree = t <> EmptyLeaf + +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 :: 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 + , on_value :: !HexString + , on_level :: !Level + , on_full :: !Bool + , on_index :: !Int64 + , on_mark :: !Bool + } deriving stock (Eq, GHC.Generic) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardNode + +instance Semigroup OrchardNode where + (<>) x y = + case combineOrchardNodes + (fromIntegral $ on_level x) + (on_value x) + (on_value y) of + Nothing -> x + Just newHash -> + OrchardNode + (max (on_position x) (on_position y)) + newHash + (1 + on_level x) + (on_full x && on_full y) + (max (on_index x) (on_index y)) + (on_mark x || on_mark y) + +instance Monoid OrchardNode where + mempty = OrchardNode 0 (hexString "00") 0 False 0 False + mappend = (<>) + +instance Node OrchardNode where + getLevel = on_level + getHash = on_value + getPosition = on_position + isFull = on_full + isMarked = on_mark + mkNode l p v = OrchardNode p v l True 0 False + +instance Show OrchardNode where + show = show . on_value + +instance Measured OrchardNode OrchardNode where + measure o p i = + OrchardNode p (on_value o) (on_level o) (on_full o) i (on_mark o) + +orchardSize :: OrchardTree -> Int64 +orchardSize tree = + (if isNothing (ot_left tree) + then 0 + else 1) + + (if isNothing (ot_right tree) + then 0 + else 1) + + foldl + (\x (i, p) -> + case p of + Nothing -> x + 0 + Just _ -> x + 2 ^ i) + 0 + (zip [1 ..] $ ot_parents tree) + +mkOrchardTree :: OrchardTree -> Tree OrchardNode +mkOrchardTree tree = + foldl + (\t (i, n) -> + case n of + Just n' -> prunedBranch i 0 n' <> t + Nothing -> t <> getEmptyRoot i) + leafRoot + (zip [1 ..] $ ot_parents tree) + where + leafRoot = + 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 = fromIntegral $ orchardSize tree - 1 diff --git a/test/Spec.hs b/test/Spec.hs index 83ba1d8..c615c1d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,17 +1,30 @@ {-# LANGUAGE OverloadedStrings #-} +import Codec.Borsh import Control.Monad (when) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Data.Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import Data.HexString import Data.Maybe (fromJust) 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 (isValidUnifiedAddress, parseAddress) +import ZcashHaskell.Orchard + ( addOrchardNodeGetRoot + , getOrchardFrontier + , getOrchardNodeValue + , getOrchardPathAnchor + , getOrchardRootTest + , getOrchardTreeAnchor + , getOrchardTreeParts + , isValidUnifiedAddress + , parseAddress + ) import ZcashHaskell.Sapling ( decodeSaplingOutputEsk , encodeSaplingAddress @@ -26,7 +39,11 @@ import ZcashHaskell.Transparent ) import ZcashHaskell.Types ( DecodedNote(..) + , MerklePath(..) + , OrchardCommitmentTree(..) + , OrchardFrontier(..) , OrchardSpendingKey(..) + , OrchardTree(..) , Phrase(..) , SaplingCommitmentTree(..) , SaplingReceiver(..) @@ -40,6 +57,7 @@ import ZcashHaskell.Types import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction) import Zenith.Core import Zenith.DB +import Zenith.Tree import Zenith.Types main :: IO () @@ -204,6 +222,171 @@ main = do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1) oNotes `shouldBe` [] + describe "Tree tests" $ do + let cmx1 = + hexString + "1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" + let cmx2 = + hexString + "39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" + let t0 = EmptyLeaf <> EmptyLeaf :: Tree OrchardNode + let t1 = t0 <> EmptyLeaf :: Tree OrchardNode + let t1a = t0 <> t0 + it "Create leaf" $ do + let n = leaf cmx1 0 0 :: Tree OrchardNode + getLevel (value n) `shouldBe` 0 + it "Create minimal tree" $ do + let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode + getLevel (value t) `shouldBe` 1 + it "Create minimal empty tree" $ do + 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 + 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 + getHash (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1) + it "Validate size of tree from Zebra" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to get parts" + Just t1 -> do + case getOrchardFrontier tree of + Nothing -> assertFailure "Failed to get frontier" + Just f1 -> do + orchardSize t1 `shouldBe` 1 + fromIntegral (of_pos f1) + it "Deserialize commitment tree from Zebra" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to get frontier" + Just t1 -> do + length (ot_parents t1) `shouldBe` 31 + it "Create commitment tree from Zebra" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to get tree parts" + Just t1 -> do + let newTree = mkOrchardTree t1 + getLevel (value newTree) `shouldBe` 32 + it "Validate commitment tree from Zebra" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to get tree parts" + Just t1 -> do + let newTree = mkOrchardTree t1 + let ctAnchor = getOrchardTreeAnchor tree + {- + -getHash (value newTree) `shouldBe` ctAnchor + -isFull (value newTree) `shouldBe` False + -} + getPosition (value newTree) `shouldBe` 39733 + it "Validate appending nodes to tree" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + let cmx1 = + hexString + "1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment + let cmx2 = + hexString + "39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment + let cmx3 = + hexString + "84f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f" :: OrchardCommitment + let cmx4 = + hexString + "e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d429" :: OrchardCommitment + let finalTree = + OrchardCommitmentTree $ + hexString + "0184f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f01e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d4291f0000014b1a76d3820087b26cd087ca84e17f3067a25ebed82ad23a93fa485affb5530b01ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case getOrchardTreeParts tree of + 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 finalAnchor = getOrchardTreeAnchor finalTree + getHash (value updatedTree4) `shouldBe` finalAnchor + it "Validate serializing tree to bytes" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case mkOrchardTree <$> getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to build tree" + Just t1 -> do + let treeBytes = serialiseBorsh t1 + LBS.length treeBytes `shouldNotBe` 0 + it "Validate deserializing tree from bytes" $ do + let tree = + OrchardCommitmentTree $ + hexString + "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" + case mkOrchardTree <$> getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to build tree" + Just t1 -> 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 diff --git a/zcash-haskell b/zcash-haskell index 6d4b684..62cda9c 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8 +Subproject commit 62cda9cc15621dead6fbfd7a4944840408d69da4 diff --git a/zenith.cabal b/zenith.cabal index 830acea..c97e222 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -36,6 +36,7 @@ library Zenith.Zcashd Zenith.Scanner Zenith.RPC + Zenith.Tree hs-source-dirs: src build-depends: @@ -49,6 +50,7 @@ library , base >=4.12 && <5 , base64-bytestring , binary + , borsh , brick , bytestring , configurator @@ -58,6 +60,7 @@ library , exceptions , filepath , ghc + , generics-sop , haskoin-core , hexstring , http-client @@ -144,6 +147,8 @@ test-suite zenith-tests , aeson , configurator , monad-logger + , borsh + , aeson , data-default , sort , text