Rene V. Vergara
d476183a1d
New type to support URI data structure created (Types.hs) Function to parse an URI string created (in Utils.hs) Test case added to Benchmark Suite
1121 lines
63 KiB
Haskell
1121 lines
63 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Codec.Borsh
|
|
import Control.Monad (when)
|
|
import Control.Monad.Logger (runNoLoggingT, 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 as T
|
|
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
|
|
import Zenith.Utils
|
|
|
|
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"
|
|
describe "Call CoinGecko to get ZEC price" $ do
|
|
it "Testing for USD " $ do
|
|
price <- getZcashPrice $ T.pack "usd"
|
|
case price of
|
|
Just p -> p `shouldNotBe` 0.0
|
|
Nothing -> assertFailure "Failed to get ZEC price"
|
|
describe "Parse an URI payment string" $ do
|
|
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
|
let zcashURI2 = "zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100&memo=SGVsbG8sIFdvcmxkIQ==&message=Test"
|
|
case parseZcashPayment zcashURI2 of
|
|
Right p -> do
|
|
print p
|
|
(uriAmount p) `shouldBe` Just 100.0
|
|
Left e -> assertFailure $ "Error: " ++ e
|