feat(db): add tree store
This commit is contained in:
parent
f2f18b5b0c
commit
b4a2e5e984
GPG key ID:
65122AD495A7F5B2
2 changed files with 488 additions and 180 deletions
105
src/Zenith/DB.hs
105
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 ()
|
||||
|
|
|
|||
563
test/Spec.hs
563
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,190 +210,386 @@ main = do
|
|||
a `shouldBe`
|
||||
Just
|
||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||
describe "Witnesses" $ do
|
||||
describe "Sapling" $ do
|
||||
it "max output id" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
sId <- getMaxSaplingNote pool
|
||||
sId `shouldBe` toSqlKey 0
|
||||
describe "Notes" $ do
|
||||
xit "Check Orchard notes" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
||||
oNotes `shouldBe` []
|
||||
xit "Check Sapling notes" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
||||
oNotes `shouldBe` []
|
||||
xit "Check transparent notes" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
||||
oNotes `shouldBe` []
|
||||
describe "Tree loading" $ do
|
||||
it "Sapling tree" $ do
|
||||
let tree =
|
||||
SaplingCommitmentTree $
|
||||
hexString
|
||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||
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
|
||||
readTree <- getSaplingTree pool
|
||||
case readTree of
|
||||
Nothing -> assertFailure "Couldn't retrieve tree from db"
|
||||
Just (t1, x) -> t1 `shouldBe` newTree
|
||||
it "Sapling tree update" $ 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
|
||||
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
|
||||
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"
|
||||
describe "Sapling" $ do
|
||||
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`
|
||||
"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"
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue