2024-05-09 19:15:37 +00:00
{- # LANGUAGE OverloadedStrings # -}
2024-11-04 16:17:54 +00:00
import Codec.Borsh
2024-05-09 19:15:37 +00:00
import Control.Monad ( when )
2024-09-23 18:04:36 +00:00
import Control.Monad.Logger ( runFileLoggingT , runNoLoggingT )
2024-10-23 20:51:05 +00:00
import Data.Aeson
2024-11-04 16:17:54 +00:00
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
2024-05-09 19:15:37 +00:00
import Data.HexString
2024-09-23 18:04:36 +00:00
import Data.Maybe ( fromJust )
2024-05-09 19:15:37 +00:00
import qualified Data.Text.Encoding as E
import Database.Persist
import Database.Persist.Sqlite
import System.Directory
2024-11-05 00:56:16 +00:00
import Test.HUnit hiding ( State ( .. ) )
2024-05-09 19:15:37 +00:00
import Test.Hspec
2024-10-29 12:01:13 +00:00
import ZcashHaskell.Orchard
2024-11-04 16:17:54 +00:00
( addOrchardNodeGetRoot
, getOrchardFrontier
, getOrchardNodeValue
2024-11-05 00:56:16 +00:00
, getOrchardPathAnchor
2024-11-04 16:17:54 +00:00
, getOrchardRootTest
2024-10-29 12:01:13 +00:00
, getOrchardTreeAnchor
2024-11-04 16:17:54 +00:00
, getOrchardTreeParts
2024-10-29 12:01:13 +00:00
, isValidUnifiedAddress
, parseAddress
)
2024-05-09 19:15:37 +00:00
import ZcashHaskell.Sapling
( decodeSaplingOutputEsk
, encodeSaplingAddress
2024-11-08 19:37:33 +00:00
, getSaplingFrontier
2024-05-09 19:15:37 +00:00
, getSaplingNotePosition
2024-11-08 19:37:33 +00:00
, getSaplingPathAnchor
, getSaplingRootTest
, getSaplingTreeAnchor
, getSaplingTreeParts
2024-05-09 19:15:37 +00:00
, getSaplingWitness
, isValidShieldedAddress
, updateSaplingCommitmentTree
)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types
( DecodedNote ( .. )
2024-11-05 00:56:16 +00:00
, MerklePath ( .. )
2024-10-29 12:01:13 +00:00
, OrchardCommitmentTree ( .. )
, OrchardFrontier ( .. )
2024-05-09 19:15:37 +00:00
, OrchardSpendingKey ( .. )
2024-11-04 16:17:54 +00:00
, OrchardTree ( .. )
2024-05-09 19:15:37 +00:00
, Phrase ( .. )
, SaplingCommitmentTree ( .. )
2024-11-08 19:37:33 +00:00
, SaplingFrontier ( .. )
2024-05-09 19:15:37 +00:00
, SaplingReceiver ( .. )
, SaplingSpendingKey ( .. )
2024-11-08 19:37:33 +00:00
, SaplingTree ( .. )
2024-05-09 19:15:37 +00:00
, Scope ( .. )
, ShieldedOutput ( .. )
2024-10-01 12:57:01 +00:00
, TxError ( .. )
2024-10-22 12:21:12 +00:00
, ValidAddress ( .. )
2024-05-09 19:15:37 +00:00
, ZcashNet ( .. )
)
2024-10-30 17:55:09 +00:00
import ZcashHaskell.Utils ( f4Jumble , makeZebraCall , readZebraTransaction )
2024-05-09 19:15:37 +00:00
import Zenith.Core
import Zenith.DB
2024-10-25 14:09:21 +00:00
import Zenith.Tree
2024-05-09 19:15:37 +00:00
import Zenith.Types
2022-06-20 21:46:13 +00:00
main :: IO ()
2024-05-09 19:15:37 +00:00
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
2024-09-23 18:04:36 +00:00
pool <- runNoLoggingT $ initPool " /home/rav/Zenith/zenith.db "
2024-05-09 19:15:37 +00:00
res <- selectUnspentNotes pool ( toSqlKey 1 ) 14000000
res ` shouldNotBe ` ( [] , [] , [] )
it " Value greater than balance " $ do
2024-09-23 18:04:36 +00:00
pool <- runNoLoggingT $ initPool " /home/rav/Zenith/zenith.db "
2024-05-09 19:15:37 +00:00
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 ->
2024-08-15 16:17:24 +00:00
case decodeExchangeAddress ( E . encodeUtf8 a ) of
2024-05-09 19:15:37 +00:00
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 ->
2024-09-23 18:04:36 +00:00
case decodeExchangeAddress ( E . encodeUtf8 a ) of
2024-05-09 19:15:37 +00:00
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 ->
2024-08-15 16:17:24 +00:00
case decodeExchangeAddress ( E . encodeUtf8 a ) of
2024-05-09 19:15:37 +00:00
Just _a4 -> True
Nothing -> False ) )
it " Check Sapling Address " $ do
let a =
encodeSaplingAddress TestNet $
SaplingReceiver
" Z$: \ 136 !u \ 171 < \ 156 \ 196 \ 210 \ SUB \ n \ 137 Hp< \ 221 \ 166 \ 146 \ SOH \ 196 \ 172 ,3< \ 255 \ 181 \ 195 / \ 239 \ 170 \ 158 \ 208 O \ 217 \ 197 \ DC3 \ 197 \ ESC \ n \ NUL - "
a ` shouldBe `
Just
" ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4 "
2024-11-08 19:37:33 +00:00
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
2024-10-25 14:09:21 +00:00
describe " Tree tests " $ do
2024-11-08 19:37:33 +00:00
describe " Sapling " $ do
2024-11-04 16:17:54 +00:00
let cmx1 =
hexString
2024-11-08 19:37:33 +00:00
" 238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17 "
let t0 = EmptyLeaf <> EmptyLeaf :: Tree SaplingNode
let t1 = t0 <> EmptyLeaf :: Tree SaplingNode
let t1a = t0 <> t0
it " Create leaf " $ do
let n = leaf cmx1 0 0 :: Tree SaplingNode
getLevel ( value n ) ` shouldBe ` 0
it " Create minimal tree " $ do
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree SaplingNode
getLevel ( value t ) ` shouldBe ` 1
it " Create minimal empty tree " $ do
getHash ( value t0 ) ` shouldNotBe ` hexString " 00 "
it " Expand empty tree " $ do t1 ` shouldBe ` t1a
it " Create empty tree non-rec " $ getEmptyRoot 2 ` shouldBe ` t1
it " Validate empty tree " $ do
getHash ( value ( getEmptyRoot 32 :: Tree SaplingNode ) ) ` shouldBe `
getSaplingRootTest 32
it " Validate size of tree from Zebra " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get parts "
Just t1 -> do
case getSaplingFrontier tree of
Nothing -> assertFailure " Failed to get frontier "
Just f1 -> do
saplingSize t1 ` shouldBe ` 1 + fromIntegral ( sf_pos f1 )
it " Deserialize commitment tree from Zebra " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get frontier "
Just t1 -> do
length ( st_parents t1 ) ` shouldBe ` 31
it " Create commitment tree from Zebra " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get tree parts "
Just t1 -> do
let newTree = mkSaplingTree t1
getLevel ( value newTree ) ` shouldBe ` 32
it " Validate commitment tree from Zebra " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get tree parts "
Just t1 -> do
let newTree = mkSaplingTree t1
let ctAnchor = getSaplingTreeAnchor tree
{-
- getHash ( value newTree ) ` shouldBe ` ctAnchor
- isFull ( value newTree ) ` shouldBe ` False
- }
getPosition ( value newTree ) ` shouldBe ` 145761
it " Validate appending nodes to tree " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
let cmu1 =
hexString
" 238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17 " :: SaplingCommitment
let finalTree =
SaplingCommitmentTree $
hexString
" 01238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17001f01fff1bcef0a4485a0beafb4813a3fd7fc7402c5efde08f56a8bb9ac99aa25ef4e000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get tree parts "
Just t1 -> do
let newTree = mkSaplingTree t1
let updatedTree1 = append newTree ( cmu1 , 4 )
let finalAnchor = getSaplingTreeAnchor finalTree
getHash ( value updatedTree1 ) ` shouldBe ` finalAnchor
it " Validate serializing tree to bytes " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case mkSaplingTree <$> getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to build tree "
Just t1 -> do
let treeBytes = serialiseBorsh t1
LBS . length treeBytes ` shouldNotBe ` 0
it " Validate deserializing tree from bytes " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
case mkSaplingTree <$> getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to build tree "
Just t1 -> do
let treeBytes = serialiseBorsh t1
let rebuiltTree = deserialiseBorsh treeBytes
rebuiltTree ` shouldBe ` Right t1
it " Create merkle path " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
let cmu1 =
hexString
" 238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17 " :: SaplingCommitment
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get tree parts "
Just t1 -> do
let newTree = mkSaplingTree t1
let updatedTree = append newTree ( cmu1 , 4 )
case path 145762 updatedTree of
Nothing -> assertFailure " Failed to get Merkle path "
Just p1 -> p1 ` shouldNotBe ` MerklePath 0 []
it " Validate merkle path " $ do
let tree =
SaplingCommitmentTree $
hexString
" 01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000 "
let cmu1 =
hexString
" 238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17 " :: SaplingCommitment
case getSaplingTreeParts tree of
Nothing -> assertFailure " Failed to get tree parts "
Just t1 -> do
let newTree = mkSaplingTree t1
let updatedTree = append newTree ( cmu1 , 4 )
case path 145762 updatedTree of
Nothing -> assertFailure " Failed to get Merkle path "
Just p1 ->
getSaplingPathAnchor cmu1 p1 ` shouldBe `
getHash ( value updatedTree )
describe " Orchard " $ do
2024-11-05 00:56:16 +00:00
let cmx1 =
hexString
2024-11-08 19:37:33 +00:00
" 1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400 "
2024-11-05 00:56:16 +00:00
let cmx2 =
hexString
2024-11-08 19:37:33 +00:00
" 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 )
2024-10-30 17:55:09 +00:00
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 "