feat(db): add tree store

src/Zenith/DB.hs

@@ -18,6 +18,7 @@
 
 module Zenith.DB where
 
+import Codec.Borsh
 import Control.Exception (SomeException(..), throw, throwIO, try)
 import Control.Monad (unless, when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -80,6 +81,7 @@ import ZcashHaskell.Types
   , ValidAddress(..)
   , ZcashNet(..)
   )
+import Zenith.Tree (OrchardNode(..), SaplingNode(..), Tree(..))
 import Zenith.Types
   ( AccountBalance(..)
   , HexStringDB(..)
@@ -304,6 +306,12 @@ share
     status ZenithStatus
     UniqueSync name
     deriving Show Eq
+  TreeStore
+    pool ZcashPool
+    bytes BS.ByteString
+    lastSync Int
+    UniquePool pool
+    deriving Show Eq
     |]
 
 -- ** Type conversions
@@ -2816,3 +2824,100 @@ rewindWalletData pool b net = do
           (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
            val net)
   logDebugN "Completed data store rewind"
+
+-- * Tree storage
+-- | Read the Orchard commitment tree
+getOrchardTree :: ConnectionPool -> IO (Maybe (Tree OrchardNode, Int))
+getOrchardTree pool = do
+  treeRecord <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        tr <- from $ table @TreeStore
+        where_ (tr ^. TreeStorePool ==. val OrchardPool)
+        pure tr
+  case treeRecord of
+    Nothing -> return Nothing
+    Just tR ->
+      case deserialiseBorsh $ BS.fromStrict $ treeStoreBytes $ entityVal tR of
+        Left _ -> return Nothing
+        Right t -> return $ Just (t, treeStoreLastSync $ entityVal tR)
+
+-- | Save the Orchard commitment tree
+upsertOrchardTree :: ConnectionPool -> Int -> Tree OrchardNode -> IO ()
+upsertOrchardTree pool ls tree = do
+  let treeBytes = BS.toStrict $ serialiseBorsh tree
+  chk <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $ do
+        tr <- from $ table @TreeStore
+        where_ (tr ^. TreeStorePool ==. val OrchardPool)
+        pure tr
+  if not (null chk)
+    then do
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do
+          update $ \p -> do
+            set p [TreeStoreBytes =. val treeBytes, TreeStoreLastSync =. val ls]
+            where_ $ p ^. TreeStorePool ==. val OrchardPool
+      return ()
+    else do
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $
+        insertUnique_ $ TreeStore OrchardPool treeBytes ls
+      return ()
+
+-- | Read the Sapling commitment tree
+getSaplingTree :: ConnectionPool -> IO (Maybe (Tree SaplingNode, Int))
+getSaplingTree pool = do
+  treeRecord <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        tr <- from $ table @TreeStore
+        where_ (tr ^. TreeStorePool ==. val SaplingPool)
+        pure tr
+  case treeRecord of
+    Nothing -> return Nothing
+    Just tR ->
+      case deserialiseBorsh $ BS.fromStrict $ treeStoreBytes $ entityVal tR of
+        Left _ -> return Nothing
+        Right t -> return $ Just (t, treeStoreLastSync $ entityVal tR)
+
+-- | Save the Sapling commitment tree
+upsertSaplingTree :: ConnectionPool -> Int -> Tree SaplingNode -> IO ()
+upsertSaplingTree pool ls tree = do
+  let treeBytes = BS.toStrict $ serialiseBorsh tree
+  chk <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $ do
+        tr <- from $ table @TreeStore
+        where_ (tr ^. TreeStorePool ==. val SaplingPool)
+        pure tr
+  if not (null chk)
+    then do
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do
+          update $ \p -> do
+            set p [TreeStoreBytes =. val treeBytes, TreeStoreLastSync =. val ls]
+            where_ $ p ^. TreeStorePool ==. val SaplingPool
+      return ()
+    else do
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $
+        insertUnique_ $ TreeStore SaplingPool treeBytes ls
+      return ()

test/Spec.hs

@@ -28,7 +28,12 @@ import ZcashHaskell.Orchard
 import ZcashHaskell.Sapling
   ( decodeSaplingOutputEsk
   , encodeSaplingAddress
+  , getSaplingFrontier
   , getSaplingNotePosition
+  , getSaplingPathAnchor
+  , getSaplingRootTest
+  , getSaplingTreeAnchor
+  , getSaplingTreeParts
   , getSaplingWitness
   , isValidShieldedAddress
   , updateSaplingCommitmentTree
@@ -46,8 +51,10 @@ import ZcashHaskell.Types
   , OrchardTree(..)
   , Phrase(..)
   , SaplingCommitmentTree(..)
+  , SaplingFrontier(..)
   , SaplingReceiver(..)
   , SaplingSpendingKey(..)
+  , SaplingTree(..)
   , Scope(..)
   , ShieldedOutput(..)
   , TxError(..)
@@ -203,26 +210,222 @@ main = do
           a `shouldBe`
             Just
               "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
-      describe "Witnesses" $ do
+      describe "Tree loading" $ do
-        describe "Sapling" $ do
+        it "Sapling tree" $ do
-          it "max output id" $ do
+          let tree =
-            pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+                SaplingCommitmentTree $
-            sId <- getMaxSaplingNote pool
+                hexString
-            sId `shouldBe` toSqlKey 0
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
-      describe "Notes" $ do
+          case getSaplingTreeParts tree of
-        xit "Check Orchard notes" $ do
+            Nothing -> assertFailure "Failed to get tree parts"
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+            Just t1 -> do
-          oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
+              pool <- runNoLoggingT $ initPool "test.db"
-          oNotes `shouldBe` []
+              let newTree = mkSaplingTree t1
-        xit "Check Sapling notes" $ do
+              _ <- upsertSaplingTree pool 2000 newTree
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+              readTree <- getSaplingTree pool
-          oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
+              case readTree of
-          oNotes `shouldBe` []
+                Nothing -> assertFailure "Couldn't retrieve tree from db"
-        xit "Check transparent notes" $ do
+                Just (t1, x) -> t1 `shouldBe` newTree
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+        it "Sapling tree update" $ do
-          oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
+          let tree =
-          oNotes `shouldBe` []
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          let cmu1 =
+                hexString
+                  "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              pool <- runNoLoggingT $ initPool "test.db"
+              let newTree = mkSaplingTree t1
+              _ <- upsertSaplingTree pool 2000 newTree
+              let updatedTree = append newTree (cmu1, 4)
+              _ <- upsertSaplingTree pool 2001 updatedTree
+              readTree <- getSaplingTree pool
+              case readTree of
+                Nothing -> assertFailure "Couldn't retrieve tree from db"
+                Just (t1, x) -> t1 `shouldBe` updatedTree
+        it "Orchard tree" $ do
+          let tree =
+                OrchardCommitmentTree $
+                hexString
+                  "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
+          let cmx1 =
+                hexString
+                  "1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
+          case getOrchardTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              pool <- runNoLoggingT $ initPool "test.db"
+              let newTree = mkOrchardTree t1
+              _ <- upsertOrchardTree pool 2000 newTree
+              readTree <- getOrchardTree pool
+              case readTree of
+                Nothing -> assertFailure "Couldn't retrieve tree from db"
+                Just (t1, x) -> t1 `shouldBe` newTree
+        it "Orchard tree update" $ do
+          let tree =
+                OrchardCommitmentTree $
+                hexString
+                  "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
+          let cmx1 =
+                hexString
+                  "1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
+          case getOrchardTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              pool <- runNoLoggingT $ initPool "test.db"
+              let newTree = mkOrchardTree t1
+              _ <- upsertOrchardTree pool 2000 newTree
+              let updatedTree = append newTree (cmx1, 4)
+              _ <- upsertOrchardTree pool 2001 updatedTree
+              readTree <- getOrchardTree pool
+              case readTree of
+                Nothing -> assertFailure "Couldn't retrieve tree from db"
+                Just (t1, x) -> t1 `shouldBe` updatedTree
     describe "Tree tests" $ do
+      describe "Sapling" $ do
+        let cmx1 =
+              hexString
+                "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17"
+        let t0 = EmptyLeaf <> EmptyLeaf :: Tree SaplingNode
+        let t1 = t0 <> EmptyLeaf :: Tree SaplingNode
+        let t1a = t0 <> t0
+        it "Create leaf" $ do
+          let n = leaf cmx1 0 0 :: Tree SaplingNode
+          getLevel (value n) `shouldBe` 0
+        it "Create minimal tree" $ do
+          let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree SaplingNode
+          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 SaplingNode)) `shouldBe`
+            getSaplingRootTest 32
+        it "Validate size of tree from Zebra" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get parts"
+            Just t1 -> do
+              case getSaplingFrontier tree of
+                Nothing -> assertFailure "Failed to get frontier"
+                Just f1 -> do
+                  saplingSize t1 `shouldBe` 1 + fromIntegral (sf_pos f1)
+        it "Deserialize commitment tree from Zebra" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get frontier"
+            Just t1 -> do
+              length (st_parents t1) `shouldBe` 31
+        it "Create commitment tree from Zebra" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              let newTree = mkSaplingTree t1
+              getLevel (value newTree) `shouldBe` 32
+        it "Validate commitment tree from Zebra" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              let newTree = mkSaplingTree t1
+              let ctAnchor = getSaplingTreeAnchor tree
+              {-
+               -getHash (value newTree) `shouldBe` ctAnchor
+               -isFull (value newTree) `shouldBe` False
+               -}
+              getPosition (value newTree) `shouldBe` 145761
+        it "Validate appending nodes to tree" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          let cmu1 =
+                hexString
+                  "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
+          let finalTree =
+                SaplingCommitmentTree $
+                hexString
+                  "01238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17001f01fff1bcef0a4485a0beafb4813a3fd7fc7402c5efde08f56a8bb9ac99aa25ef4e000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              let newTree = mkSaplingTree t1
+              let updatedTree1 = append newTree (cmu1, 4)
+              let finalAnchor = getSaplingTreeAnchor finalTree
+              getHash (value updatedTree1) `shouldBe` finalAnchor
+        it "Validate serializing tree to bytes" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case mkSaplingTree <$> getSaplingTreeParts 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 =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          case mkSaplingTree <$> getSaplingTreeParts 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 =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          let cmu1 =
+                hexString
+                  "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              let newTree = mkSaplingTree t1
+              let updatedTree = append newTree (cmu1, 4)
+              case path 145762 updatedTree of
+                Nothing -> assertFailure "Failed to get Merkle path"
+                Just p1 -> p1 `shouldNotBe` MerklePath 0 []
+        it "Validate merkle path" $ do
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
+          let cmu1 =
+                hexString
+                  "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
+          case getSaplingTreeParts tree of
+            Nothing -> assertFailure "Failed to get tree parts"
+            Just t1 -> do
+              let newTree = mkSaplingTree t1
+              let updatedTree = append newTree (cmu1, 4)
+              case path 145762 updatedTree of
+                Nothing -> assertFailure "Failed to get Merkle path"
+                Just p1 ->
+                  getSaplingPathAnchor cmu1 p1 `shouldBe`
+                  getHash (value updatedTree)
+      describe "Orchard" $ do
         let cmx1 =
               hexString
                 "1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"