{-# LANGUAGE OverloadedStrings #-} import Codec.Borsh import Control.Monad (when) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.HexString import Data.List (foldl') import Data.Maybe (fromJust) import qualified Data.Text.Encoding as E import Database.Persist import Database.Persist.Sqlite import System.Directory import Test.HUnit hiding (State(..)) import Test.Hspec import ZcashHaskell.Orchard ( addOrchardNodeGetRoot , getOrchardFrontier , getOrchardNodeValue , getOrchardPathAnchor , getOrchardRootTest , getOrchardTreeAnchor , getOrchardTreeParts , isValidUnifiedAddress , parseAddress ) import ZcashHaskell.Sapling ( decodeSaplingOutputEsk , encodeSaplingAddress , getSaplingFrontier , getSaplingNotePosition , getSaplingPathAnchor , getSaplingRootTest , getSaplingTreeAnchor , getSaplingTreeParts , getSaplingWitness , isValidShieldedAddress , updateSaplingCommitmentTree ) import ZcashHaskell.Transparent ( decodeExchangeAddress , decodeTransparentAddress , encodeExchangeAddress ) import ZcashHaskell.Types ( DecodedNote(..) , MerklePath(..) , OrchardCommitmentTree(..) , OrchardFrontier(..) , OrchardSpendingKey(..) , OrchardTree(..) , Phrase(..) , SaplingCommitmentTree(..) , SaplingFrontier(..) , SaplingReceiver(..) , SaplingSpendingKey(..) , SaplingTree(..) , Scope(..) , ShieldedOutput(..) , TxError(..) , UnifiedAddress(..) , ValidAddress(..) , ZcashNet(..) ) import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction) import Zenith.Core import Zenith.DB import Zenith.Tree import Zenith.Types main :: IO () main = do checkDbFile <- doesFileExist "test.db" when checkDbFile $ removeFile "test.db" hspec $ do describe "Database tests" $ do it "Create table" $ do s <- runSqlite "test.db" $ do runMigration migrateAll s `shouldBe` () describe "Wallet Table" $ do it "insert wallet record" $ do s <- runSqlite "test.db" $ do insert $ ZcashWallet "Main Wallet" (ZcashNetDB MainNet) (PhraseDB $ Phrase "one two three four five six seven eight nine ten eleven twelve") 2000000 0 fromSqlKey s `shouldBe` 1 it "read wallet record" $ do s <- runSqlite "test.db" $ do selectList [ZcashWalletBirthdayHeight >. 0] [] length s `shouldBe` 1 it "modify wallet record" $ do s <- runSqlite "test.db" $ do let recId = toSqlKey 1 :: ZcashWalletId update recId [ZcashWalletName =. "New Wallet"] get recId "New Wallet" `shouldBe` maybe "None" zcashWalletName s it "delete wallet record" $ do s <- runSqlite "test.db" $ do let recId = toSqlKey 1 :: ZcashWalletId delete recId get recId "None" `shouldBe` maybe "None" zcashWalletName s describe "Wallet function tests:" $ do it "Save Wallet:" $ do pool <- runNoLoggingT $ initPool "test.db" zw <- saveWallet pool $ ZcashWallet "Testing" (ZcashNetDB MainNet) (PhraseDB $ Phrase "cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest") 2200000 0 zw `shouldNotBe` Nothing it "Save Account:" $ do pool <- runNoLoggingT $ initPool "test.db" s <- runSqlite "test.db" $ do selectList [ZcashWalletName ==. "Testing"] [] za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s) za `shouldNotBe` Nothing it "Save address:" $ do pool <- runNoLoggingT $ initPool "test.db" acList <- runSqlite "test.db" $ selectList [ZcashAccountName ==. "TestAccount"] [] zAdd <- saveAddress pool =<< createWalletAddress "Personal123" 0 MainNet External (head acList) addList <- runSqlite "test.db" $ selectList [ WalletAddressName ==. "Personal123" , WalletAddressScope ==. ScopeDB External ] [] getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe` "u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m" it "Address components are correct" $ do let ua = "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" isValidUnifiedAddress ua `shouldNotBe` Nothing describe "Note selection for Tx" $ do it "Value less than balance" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" res <- selectUnspentNotes pool (toSqlKey 1) 14000000 res `shouldNotBe` ([], [], []) it "Value greater than balance" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" let res = selectUnspentNotes pool (toSqlKey 1) 84000000 res `shouldThrow` anyIOException describe "Testing validation" $ do it "Unified" $ do let a = "utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu" True `shouldBe` (case isValidUnifiedAddress (E.encodeUtf8 a) of Just _a1 -> True Nothing -> isValidShieldedAddress (E.encodeUtf8 a) || (case decodeTransparentAddress (E.encodeUtf8 a) of Just _a3 -> True Nothing -> case decodeExchangeAddress (E.encodeUtf8 a) of Just _a4 -> True Nothing -> False)) it "Sapling" $ do let a = "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" True `shouldBe` (case isValidUnifiedAddress (E.encodeUtf8 a) of Just _a1 -> True Nothing -> isValidShieldedAddress (E.encodeUtf8 a) || (case decodeTransparentAddress (E.encodeUtf8 a) of Just _a3 -> True Nothing -> case decodeExchangeAddress (E.encodeUtf8 a) of Just _a4 -> True Nothing -> False)) it "Transparent" $ do let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3" True `shouldBe` (case isValidUnifiedAddress (E.encodeUtf8 a) of Just _a1 -> True Nothing -> isValidShieldedAddress (E.encodeUtf8 a) || (case decodeTransparentAddress (E.encodeUtf8 a) of Just _a3 -> True Nothing -> case decodeExchangeAddress (E.encodeUtf8 a) of Just _a4 -> True Nothing -> False)) it "Check Sapling Address" $ do let a = encodeSaplingAddress TestNet $ SaplingReceiver "Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-" a `shouldBe` Just "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" 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 describe "Sapling" $ do let cmx1 = hexString "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" let t0 = EmptyLeaf <> EmptyLeaf :: Tree SaplingNode let t1 = t0 <> EmptyLeaf :: Tree SaplingNode let t1a = t0 <> t0 it "Create leaf" $ do let n = leaf cmx1 0 0 :: Tree SaplingNode getLevel (value n) `shouldBe` 0 it "Create minimal tree" $ do let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree SaplingNode getLevel (value t) `shouldBe` 1 it "Create minimal empty tree" $ do getHash (value t0) `shouldNotBe` hexString "00" it "Expand empty tree" $ do t1 `shouldBe` t1a it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1 it "Validate empty tree" $ do getHash (value (getEmptyRoot 32 :: Tree SaplingNode)) `shouldBe` getSaplingRootTest 32 it "Validate size of tree from Zebra" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get parts" Just t1 -> do case getSaplingFrontier tree of Nothing -> assertFailure "Failed to get frontier" Just f1 -> do saplingSize t1 `shouldBe` 1 + fromIntegral (sf_pos f1) it "Deserialize commitment tree from Zebra" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get frontier" Just t1 -> do length (st_parents t1) `shouldBe` 31 it "Create commitment tree from Zebra" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkSaplingTree t1 getLevel (value newTree) `shouldBe` 32 it "Validate commitment tree from Zebra" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkSaplingTree t1 let ctAnchor = getSaplingTreeAnchor tree {- -getHash (value newTree) `shouldBe` ctAnchor -isFull (value newTree) `shouldBe` False -} getPosition (value newTree) `shouldBe` 145761 it "Validate appending nodes to tree" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" let cmu1 = hexString "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment let finalTree = SaplingCommitmentTree $ hexString "01238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17001f01fff1bcef0a4485a0beafb4813a3fd7fc7402c5efde08f56a8bb9ac99aa25ef4e000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkSaplingTree t1 let updatedTree1 = append newTree (cmu1, 4) let finalAnchor = getSaplingTreeAnchor finalTree getHash (value updatedTree1) `shouldBe` finalAnchor it "Validate serializing tree to bytes" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case mkSaplingTree <$> getSaplingTreeParts tree of Nothing -> assertFailure "Failed to build tree" Just t1 -> do let treeBytes = serialiseBorsh t1 LBS.length treeBytes `shouldNotBe` 0 it "Validate deserializing tree from bytes" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" case mkSaplingTree <$> getSaplingTreeParts tree of Nothing -> assertFailure "Failed to build tree" Just t1 -> do let treeBytes = serialiseBorsh t1 let rebuiltTree = deserialiseBorsh treeBytes rebuiltTree `shouldBe` Right t1 it "Create merkle path" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" let cmu1 = hexString "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkSaplingTree t1 let updatedTree = append newTree (cmu1, 4) case path 145762 updatedTree of Nothing -> assertFailure "Failed to get Merkle path" Just p1 -> p1 `shouldNotBe` MerklePath 0 [] it "Validate merkle path" $ do let tree = SaplingCommitmentTree $ hexString "01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000" let cmu1 = hexString "238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment case getSaplingTreeParts tree of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkSaplingTree t1 let updatedTree = append newTree (cmu1, 4) case path 145762 updatedTree of Nothing -> assertFailure "Failed to get Merkle path" Just p1 -> getSaplingPathAnchor cmu1 p1 `shouldBe` getHash (value updatedTree) it "Find position by index" $ 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) getNotePosition updatedTree 4 `shouldBe` Just 145762 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) it "Find position by index" $ 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)] getNotePosition updatedTree 4 `shouldBe` Just 39734 it "Truncate tree" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" maxBlock <- getMaxBlock pool $ ZcashNetDB TestNet dbTree <- getOrchardTree pool case dbTree of Nothing -> assertFailure "failed to get tree from DB" Just (oTree, oSync) -> do let startBlock = oSync - 5 zebraTreesIn <- getCommitmentTrees pool "localhost" 18232 (ZcashNetDB TestNet) startBlock ix <- getOrchardActionAtBlock pool (ZcashNetDB TestNet) startBlock case ix of Nothing -> assertFailure "couldn't find index at block" Just i -> do updatedTree <- runNoLoggingT $ truncateTree oTree i let finalAnchor = getOrchardTreeAnchor $ OrchardCommitmentTree $ ztiOrchard zebraTreesIn getHash (value updatedTree) `shouldBe` finalAnchor it "Counting leaves in tree" $ do let tree = OrchardCommitmentTree $ hexString "0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000" case getOrchardTreeParts tree of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkOrchardTree t1 countLeaves newTree `shouldBe` fromIntegral (1 + getPosition (value newTree)) it "Validate large load" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" maxBlock <- getMaxBlock pool $ ZcashNetDB TestNet let startBlock = maxBlock - 310000 zebraTreesIn <- getCommitmentTrees pool "localhost" 18232 (ZcashNetDB TestNet) startBlock zebraTreesOut <- getCommitmentTrees pool "localhost" 18232 (ZcashNetDB TestNet) maxBlock case getOrchardTreeParts $ OrchardCommitmentTree $ ztiOrchard zebraTreesIn of Nothing -> assertFailure "Failed to get tree parts" Just t1 -> do let newTree = mkOrchardTree t1 oAct <- getOrchardActions pool startBlock $ ZcashNetDB TestNet let cmxs = map (\(_, y) -> ( getHex $ orchActionCmx $ entityVal y , fromSqlKey $ entityKey y)) oAct let posCmx = zip [(getPosition (value newTree) + 1) ..] cmxs let updatedTree = batchAppend newTree posCmx let finalAnchor = getOrchardTreeAnchor $ OrchardCommitmentTree $ ztiOrchard zebraTreesOut getHash (value updatedTree) `shouldBe` finalAnchor it "Validate tree from DB" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" dbTree <- getOrchardTree pool case dbTree of Nothing -> assertFailure "failed to get tree from DB" Just (oTree, oSync) -> do zebraTrees <- getCommitmentTrees pool "localhost" 18232 (ZcashNetDB TestNet) oSync let finalAnchor = getOrchardTreeAnchor $ OrchardCommitmentTree $ ztiOrchard zebraTrees getHash (value oTree) `shouldBe` finalAnchor describe "TEX address" $ do it "from UA" $ do let addr = parseAddress "utest1fqtne08sdgmae0g0un7j3h6ss9gafguprv0yvkxv4trxxsdxx467pxkkc98cpsyk5r2enwwpn3p5c6aw537wyvlz20hs7vcqc4uhm22yfjnrsm8hy2hjjrscvhk2ac32rzndu94hh28gdl62wqgy3yev7w0gj9lmmz6yasghmle6tllx4yjv9sjt0xml66y9lyxc4rkk6q425nc5gxa" case addr of Nothing -> assertFailure "failed to parse address" Just (Unified ua) -> case (encodeExchangeAddress (ua_net ua) =<< (t_rec ua)) of Nothing -> assertFailure "failed to encode TEX" Just tex -> tex `shouldBe` "textest1jze8c9jxxrpct34tpe4pvquz8nvxsxt6gawqqf" Just _ -> assertFailure "no transparent receiver" describe "Creating Tx" $ do describe "Full" $ do it "To Orchard" $ do let uaRead = parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 3) 3026170 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 (Just "Sending memo to orchard") ] Full case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` hexString "deadbeef" it "To Sapling" $ do let uaRead = parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 4) 3001331 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 (Just "Sending memo to sapling") ] Full case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` hexString "deadbeef" it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 4) 3001331 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] Full tx `shouldBe` Left (PrivacyPolicyError "Receiver not capable of Full privacy") it "To mixed shielded receivers" $ do let uaRead = parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" let uaRead2 = parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001331 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 (Just "Sending memo to orchard") , ProposedNote (ValidAddressAPI $ fromJust uaRead2) 0.004 Nothing ] Full tx `shouldBe` Left (PrivacyPolicyError "Combination of receivers not allowed for Full privacy") describe "Medium" $ do it "To Orchard" $ do let uaRead = parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 (Just "Sending memo to orchard") ] Medium case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` hexString "deadbeef" it "To Sapling" $ do let uaRead = parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 (Just "Sending memo to sapling") ] Medium case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "00") it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 4) 3001331 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] Medium tx `shouldBe` Left (PrivacyPolicyError "Receiver not capable of Medium privacy") it "To mixed shielded receivers" $ do let uaRead = parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" let uaRead2 = parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001331 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 (Just "Sending memo to orchard") , ProposedNote (ValidAddressAPI $ fromJust uaRead2) 0.004 Nothing ] Medium case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef") describe "Low" $ do it "To Orchard" $ do let uaRead = parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] Low case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef") it "To Sapling" $ do let uaRead = parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] Low case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef") it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] Low case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` (hexString "deadbeef") describe "None" $ do it "To Orchard" $ do let uaRead = parseAddress "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] None tx `shouldBe` Left (PrivacyPolicyError "Shielded recipients not compatible with privacy policy.") it "To Sapling" $ do let uaRead = parseAddress "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] None tx `shouldBe` Left (PrivacyPolicyError "Shielded recipients not compatible with privacy policy.") it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of Nothing -> assertFailure "wrong address" Just ua -> do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" tx <- runNoLoggingT $ prepareTxV2 pool "localhost" 18232 TestNet (toSqlKey 1) 3001372 [ ProposedNote (ValidAddressAPI $ fromJust uaRead) 0.005 Nothing ] None case tx of Left e -> assertFailure $ show e Right h -> h `shouldNotBe` hexString "deadbeef"