{-# LANGUAGE OverloadedStrings #-} import Codec.Borsh import Control.Monad (when) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.HexString import Data.Maybe (fromJust) import qualified Data.Text.Encoding as E 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 ) import ZcashHaskell.Types ( DecodedNote(..) , MerklePath(..) , OrchardCommitmentTree(..) , OrchardFrontier(..) , OrchardSpendingKey(..) , OrchardTree(..) , Phrase(..) , SaplingCommitmentTree(..) , SaplingFrontier(..) , SaplingReceiver(..) , SaplingSpendingKey(..) , SaplingTree(..) , Scope(..) , ShieldedOutput(..) , TxError(..) , 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 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)] let truncTree = truncateTree updatedTree 4 getIndex (value truncTree) `shouldBe` 4 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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 <- runFileLoggingT "zenith.log" $ 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"