diff --git a/src/Zenith/Tree.hs b/src/Zenith/Tree.hs index 7258c79..cc8fe7b 100644 --- a/src/Zenith/Tree.hs +++ b/src/Zenith/Tree.hs @@ -1,15 +1,23 @@ {-# 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 (Int64) +import Data.Int (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 (OrchardFrontier(..)) +import ZcashHaskell.Types (MerklePath(..), OrchardFrontier(..), OrchardTree(..)) -type Level = Integer +type Level = Int8 maxLevel :: Level maxLevel = 32 @@ -19,29 +27,33 @@ type Position = Int64 class Monoid v => Measured a v where - measure :: a -> Position -> v + measure :: a -> Position -> Int64 -> v class Node v where getLevel :: v -> Level getTag :: 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 = + measure oc p i = case getOrchardNodeValue (hexBytes oc) of - Nothing -> OrchardNode 0 (hexString "00") 0 True - Just val -> OrchardNode p val 0 True + 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) - deriving (Eq) + | 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 = "()" @@ -49,90 +61,69 @@ instance (Node v, Show v) => Show (Tree v) where show (PrunedBranch v) = "{" ++ show v ++ "}" show (Branch s x y) = "<" ++ show (getTag 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 x) Branch {} = Leaf x - (<>) (Leaf x) (PrunedBranch _) = Leaf x + (<>) (Leaf _) Branch {} = InvalidTree + (<>) (Leaf _) (PrunedBranch _) = InvalidTree (<>) (PrunedBranch x) EmptyLeaf = PrunedBranch $ x <> x - (<>) (PrunedBranch x) (Leaf _) = PrunedBranch 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 EmptyLeaf + 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 _) = Branch s x y + (<>) (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 = Branch s x y + | 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 -> Int64 -> Tree v -leaf a p = Leaf (measure a p) +leaf :: Measured a v => a -> Int64 -> 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 - 1 + if getLevel (value tree) == maxLevel then tree - else mkSubTree (maxLevel - 1) tree + else mkSubTree maxLevel tree getEmptyRoot :: Monoid v => Node v => Level -> Tree v getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level -data OrchardNode = OrchardNode - { on_position :: !Position - , on_value :: !HexString - , on_level :: !Level - , on_full :: !Bool - } deriving (Eq) - -instance Semigroup OrchardNode where - (<>) x y = - case combineOrchardNodes (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) - -instance Monoid OrchardNode where - mempty = OrchardNode 0 (hexString "00") 0 False - mappend = (<>) - -instance Node OrchardNode where - getLevel = on_level - getTag = on_value - getPosition = on_position - isFull = on_full - mkNode l p v = OrchardNode p v l True - -instance Show OrchardNode where - show = show . on_value - -instance Measured OrchardNode OrchardNode where - measure o p = OrchardNode p (on_value o) (on_level o) (on_full o) +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 = @@ -142,20 +133,85 @@ mkSubTree level t = where subtree = t <> EmptyLeaf -mkOrchardTree :: OrchardFrontier -> Tree OrchardNode -mkOrchardTree (OrchardFrontier p l o) = - if odd p - then addOrchardOmmers (tail o) $ - Leaf (OrchardNode (p - 1) (head o) 0 True) <> - Leaf (OrchardNode p l 0 True) - else addOrchardOmmers o $ Leaf (OrchardNode p l 0 True) <> EmptyLeaf - -addOrchardOmmers :: [HexString] -> Tree OrchardNode -> Tree OrchardNode -addOrchardOmmers xs t = - foldl - (\s x -> PrunedBranch (mkNode (getLevel $ value s) (p (value s)) x) <> s) - t - xs +path :: Position -> Tree v -> Maybe MerklePath +path pos (Branch s x y) = undefined where - p :: OrchardNode -> Position - p (OrchardNode pos _ l _) = pos - (2 ^ l) + collectPath t = undefined + +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 + getTag = 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 = orchardSize tree - 1 diff --git a/test/Spec.hs b/test/Spec.hs index 794e983..d063add 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,8 +1,11 @@ {-# 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 @@ -12,8 +15,12 @@ import System.Directory import Test.HUnit import Test.Hspec import ZcashHaskell.Orchard - ( getOrchardFrontier + ( addOrchardNodeGetRoot + , getOrchardFrontier + , getOrchardNodeValue + , getOrchardRootTest , getOrchardTreeAnchor + , getOrchardTreeParts , isValidUnifiedAddress , parseAddress ) @@ -34,6 +41,7 @@ import ZcashHaskell.Types , OrchardCommitmentTree(..) , OrchardFrontier(..) , OrchardSpendingKey(..) + , OrchardTree(..) , Phrase(..) , SaplingCommitmentTree(..) , SaplingReceiver(..) @@ -216,49 +224,127 @@ main = 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 1 :: Tree OrchardNode + let n = leaf cmx1 0 0 :: Tree OrchardNode getLevel (value n) `shouldBe` 0 it "Create minimal tree" $ do - let t = (leaf cmx1 1) <> EmptyLeaf :: Tree OrchardNode + 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" it "Expand empty tree" $ do t1 `shouldBe` t1a - it "Create empty tree" $ mkSubTree 2 EmptyLeaf `shouldBe` t1 it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1 - it "Create a tree from Frontier" $ do + it "Validate empty tree" $ do + getTag (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) + it "Validate size of tree from Zebra" $ do let tree = OrchardCommitmentTree $ hexString "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" - case getOrchardFrontier tree of - Nothing -> assertFailure "Failed to get frontier" + case getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to get parts" Just t1 -> do - of_ommers t1 `shouldBe` [] - it "Validate a tree's depth from Frontier" $ 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 getOrchardFrontier tree of + case getOrchardTreeParts tree of Nothing -> assertFailure "Failed to get frontier" Just t1 -> do - let t = root $ mkOrchardTree t1 - getLevel (value t) `shouldBe` 31 - it "Validate a tree from Frontier" $ do + length (ot_parents t1) `shouldBe` 31 + it "Create commitment tree from Zebra" $ do let tree = OrchardCommitmentTree $ hexString "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" - case getOrchardFrontier tree of - Nothing -> assertFailure "Failed to get frontier" + case getOrchardTreeParts tree of + Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do - let t = root $ mkOrchardTree t1 - getTag (value t) `shouldBe` getOrchardTreeAnchor t1 + 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 + {- + -getTag (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 + getTag (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 describe "Creating Tx" $ do describe "Full" $ do it "To Orchard" $ do diff --git a/zcash-haskell b/zcash-haskell index f6b8a77..7092764 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit f6b8a772770f492221dc99281016d7090f981e63 +Subproject commit 70927645e774d53dd04650d68d996670033a8ef1 diff --git a/zenith.cabal b/zenith.cabal index 2f32e51..c97e222 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -50,6 +50,7 @@ library , base >=4.12 && <5 , base64-bytestring , binary + , borsh , brick , bytestring , configurator @@ -59,6 +60,7 @@ library , exceptions , filepath , ghc + , generics-sop , haskoin-core , hexstring , http-client @@ -145,6 +147,7 @@ test-suite zenith-tests , aeson , configurator , monad-logger + , borsh , aeson , data-default , sort