RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
2 changed files with 488 additions and 180 deletions
Showing only changes of commit b4a2e5e984 - Show all commits

View file

@ -18,6 +18,7 @@
module Zenith.DB where module Zenith.DB where
import Codec.Borsh
import Control.Exception (SomeException(..), throw, throwIO, try) import Control.Exception (SomeException(..), throw, throwIO, try)
import Control.Monad (unless, when) import Control.Monad (unless, when)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
@ -80,6 +81,7 @@ import ZcashHaskell.Types
, ValidAddress(..) , ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import Zenith.Tree (OrchardNode(..), SaplingNode(..), Tree(..))
import Zenith.Types import Zenith.Types
( AccountBalance(..) ( AccountBalance(..)
, HexStringDB(..) , HexStringDB(..)
@ -304,6 +306,12 @@ share
status ZenithStatus status ZenithStatus
UniqueSync name UniqueSync name
deriving Show Eq deriving Show Eq
TreeStore
pool ZcashPool
bytes BS.ByteString
lastSync Int
UniquePool pool
deriving Show Eq
|] |]
-- ** Type conversions -- ** Type conversions
@ -2816,3 +2824,100 @@ rewindWalletData pool b net = do
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==. (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net) val net)
logDebugN "Completed data store rewind" 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 ()

View file

@ -28,7 +28,12 @@ import ZcashHaskell.Orchard
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( decodeSaplingOutputEsk ( decodeSaplingOutputEsk
, encodeSaplingAddress , encodeSaplingAddress
, getSaplingFrontier
, getSaplingNotePosition , getSaplingNotePosition
, getSaplingPathAnchor
, getSaplingRootTest
, getSaplingTreeAnchor
, getSaplingTreeParts
, getSaplingWitness , getSaplingWitness
, isValidShieldedAddress , isValidShieldedAddress
, updateSaplingCommitmentTree , updateSaplingCommitmentTree
@ -46,8 +51,10 @@ import ZcashHaskell.Types
, OrchardTree(..) , OrchardTree(..)
, Phrase(..) , Phrase(..)
, SaplingCommitmentTree(..) , SaplingCommitmentTree(..)
, SaplingFrontier(..)
, SaplingReceiver(..) , SaplingReceiver(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, SaplingTree(..)
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, TxError(..) , TxError(..)
@ -203,190 +210,386 @@ main = do
a `shouldBe` a `shouldBe`
Just Just
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" "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 "Tree tests" $ do
let cmx1 = describe "Sapling" $ do
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 = let cmx1 =
hexString hexString
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17"
let cmx2 = let t0 = EmptyLeaf <> EmptyLeaf :: Tree SaplingNode
hexString let t1 = t0 <> EmptyLeaf :: Tree SaplingNode
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment let t1a = t0 <> t0
let cmx3 = it "Create leaf" $ do
hexString let n = leaf cmx1 0 0 :: Tree SaplingNode
"84f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f" :: OrchardCommitment getLevel (value n) `shouldBe` 0
let cmx4 = it "Create minimal tree" $ do
hexString let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree SaplingNode
"e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d429" :: OrchardCommitment getLevel (value t) `shouldBe` 1
let finalTree = it "Create minimal empty tree" $ do
OrchardCommitmentTree $ getHash (value t0) `shouldNotBe` hexString "00"
hexString it "Expand empty tree" $ do t1 `shouldBe` t1a
"0184f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f01e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d4291f0000014b1a76d3820087b26cd087ca84e17f3067a25ebed82ad23a93fa485affb5530b01ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
case getOrchardTreeParts tree of it "Validate empty tree" $ do
Nothing -> assertFailure "Failed to get tree parts" getHash (value (getEmptyRoot 32 :: Tree SaplingNode)) `shouldBe`
Just t1 -> do getSaplingRootTest 32
let newTree = mkOrchardTree t1 it "Validate size of tree from Zebra" $ do
let updatedTree1 = append newTree (cmx1, 4) let tree =
let updatedTree2 = append updatedTree1 (cmx2, 5) SaplingCommitmentTree $
let updatedTree3 = append updatedTree2 (cmx3, 6) hexString
let updatedTree4 = append updatedTree3 (cmx4, 7) "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
let finalAnchor = getOrchardTreeAnchor finalTree case getSaplingTreeParts tree of
getHash (value updatedTree4) `shouldBe` finalAnchor Nothing -> assertFailure "Failed to get parts"
it "Validate serializing tree to bytes" $ do Just t1 -> do
let tree = case getSaplingFrontier tree of
OrchardCommitmentTree $ Nothing -> assertFailure "Failed to get frontier"
hexString Just f1 -> do
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" saplingSize t1 `shouldBe` 1 + fromIntegral (sf_pos f1)
case mkOrchardTree <$> getOrchardTreeParts tree of it "Deserialize commitment tree from Zebra" $ do
Nothing -> assertFailure "Failed to build tree" let tree =
Just t1 -> do SaplingCommitmentTree $
let treeBytes = serialiseBorsh t1 hexString
LBS.length treeBytes `shouldNotBe` 0 "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
it "Validate deserializing tree from bytes" $ do case getSaplingTreeParts tree of
let tree = Nothing -> assertFailure "Failed to get frontier"
OrchardCommitmentTree $ Just t1 -> do
hexString length (st_parents t1) `shouldBe` 31
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" it "Create commitment tree from Zebra" $ do
case mkOrchardTree <$> getOrchardTreeParts tree of let tree =
Nothing -> assertFailure "Failed to build tree" SaplingCommitmentTree $
Just t1 -> do hexString
let treeBytes = serialiseBorsh t1 "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
let rebuiltTree = deserialiseBorsh treeBytes case getSaplingTreeParts tree of
rebuiltTree `shouldBe` Right t1 Nothing -> assertFailure "Failed to get tree parts"
it "Create merkle path" $ do Just t1 -> do
let tree = let newTree = mkSaplingTree t1
OrchardCommitmentTree $ getLevel (value newTree) `shouldBe` 32
hexString it "Validate commitment tree from Zebra" $ do
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" let tree =
let cmx1 = SaplingCommitmentTree $
hexString hexString
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
let cmx2 = case getSaplingTreeParts tree of
hexString Nothing -> assertFailure "Failed to get tree parts"
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment Just t1 -> do
case getOrchardTreeParts tree of let newTree = mkSaplingTree t1
Nothing -> assertFailure "Failed to get tree parts" let ctAnchor = getSaplingTreeAnchor tree
Just t1 -> do {-
let newTree = mkOrchardTree t1 -getHash (value newTree) `shouldBe` ctAnchor
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)] -isFull (value newTree) `shouldBe` False
case path 39735 updatedTree of -}
Nothing -> assertFailure "Failed to get Merkle path" getPosition (value newTree) `shouldBe` 145761
Just p1 -> p1 `shouldNotBe` MerklePath 0 [] it "Validate appending nodes to tree" $ do
it "Validate merkle path" $ do let tree =
let tree = SaplingCommitmentTree $
OrchardCommitmentTree $ hexString
hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" let cmu1 =
let cmx1 = hexString
hexString "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment let finalTree =
let cmx2 = SaplingCommitmentTree $
hexString hexString
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment "01238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17001f01fff1bcef0a4485a0beafb4813a3fd7fc7402c5efde08f56a8bb9ac99aa25ef4e000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
case getOrchardTreeParts tree of case getSaplingTreeParts tree of
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 = mkSaplingTree t1
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)] let updatedTree1 = append newTree (cmu1, 4)
case path 39735 updatedTree of let finalAnchor = getSaplingTreeAnchor finalTree
Nothing -> assertFailure "Failed to get Merkle path" getHash (value updatedTree1) `shouldBe` finalAnchor
Just p1 -> do it "Validate serializing tree to bytes" $ do
getOrchardPathAnchor cmx2 p1 `shouldBe` 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) getHash (value updatedTree)
describe "Orchard" $ 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 "Creating Tx" $ do
describe "Full" $ do describe "Full" $ do
it "To Orchard" $ do it "To Orchard" $ do