725 lines
34 KiB
Haskell
725 lines
34 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Codec.Borsh
|
|
import Control.Monad (when)
|
|
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
|
import Data.Aeson
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import Data.HexString
|
|
import Data.Maybe (fromJust)
|
|
import qualified Data.Text.Encoding as E
|
|
import Database.Persist
|
|
import Database.Persist.Sqlite
|
|
import System.Directory
|
|
import Test.HUnit
|
|
import Test.Hspec
|
|
import ZcashHaskell.Orchard
|
|
( addOrchardNodeGetRoot
|
|
, getOrchardFrontier
|
|
, getOrchardNodeValue
|
|
, getOrchardRootTest
|
|
, getOrchardTreeAnchor
|
|
, getOrchardTreeParts
|
|
, isValidUnifiedAddress
|
|
, parseAddress
|
|
)
|
|
import ZcashHaskell.Sapling
|
|
( decodeSaplingOutputEsk
|
|
, encodeSaplingAddress
|
|
, getSaplingNotePosition
|
|
, getSaplingWitness
|
|
, isValidShieldedAddress
|
|
, updateSaplingCommitmentTree
|
|
)
|
|
import ZcashHaskell.Transparent
|
|
( decodeExchangeAddress
|
|
, decodeTransparentAddress
|
|
)
|
|
import ZcashHaskell.Types
|
|
( DecodedNote(..)
|
|
, OrchardCommitmentTree(..)
|
|
, OrchardFrontier(..)
|
|
, OrchardSpendingKey(..)
|
|
, OrchardTree(..)
|
|
, Phrase(..)
|
|
, SaplingCommitmentTree(..)
|
|
, SaplingReceiver(..)
|
|
, SaplingSpendingKey(..)
|
|
, Scope(..)
|
|
, ShieldedOutput(..)
|
|
, TxError(..)
|
|
, ValidAddress(..)
|
|
, ZcashNet(..)
|
|
)
|
|
import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
|
|
import Zenith.Core
|
|
import Zenith.DB
|
|
import Zenith.Tree
|
|
import Zenith.Types
|
|
|
|
main :: IO ()
|
|
main = do
|
|
checkDbFile <- doesFileExist "test.db"
|
|
when checkDbFile $ removeFile "test.db"
|
|
hspec $ do
|
|
describe "Database tests" $ do
|
|
it "Create table" $ do
|
|
s <- runSqlite "test.db" $ do runMigration migrateAll
|
|
s `shouldBe` ()
|
|
describe "Wallet Table" $ do
|
|
it "insert wallet record" $ do
|
|
s <-
|
|
runSqlite "test.db" $ do
|
|
insert $
|
|
ZcashWallet
|
|
"Main Wallet"
|
|
(ZcashNetDB MainNet)
|
|
(PhraseDB $
|
|
Phrase
|
|
"one two three four five six seven eight nine ten eleven twelve")
|
|
2000000
|
|
0
|
|
fromSqlKey s `shouldBe` 1
|
|
it "read wallet record" $ do
|
|
s <-
|
|
runSqlite "test.db" $ do
|
|
selectList [ZcashWalletBirthdayHeight >. 0] []
|
|
length s `shouldBe` 1
|
|
it "modify wallet record" $ do
|
|
s <-
|
|
runSqlite "test.db" $ do
|
|
let recId = toSqlKey 1 :: ZcashWalletId
|
|
update recId [ZcashWalletName =. "New Wallet"]
|
|
get recId
|
|
"New Wallet" `shouldBe` maybe "None" zcashWalletName s
|
|
it "delete wallet record" $ do
|
|
s <-
|
|
runSqlite "test.db" $ do
|
|
let recId = toSqlKey 1 :: ZcashWalletId
|
|
delete recId
|
|
get recId
|
|
"None" `shouldBe` maybe "None" zcashWalletName s
|
|
describe "Wallet function tests:" $ do
|
|
it "Save Wallet:" $ do
|
|
pool <- runNoLoggingT $ initPool "test.db"
|
|
zw <-
|
|
saveWallet pool $
|
|
ZcashWallet
|
|
"Testing"
|
|
(ZcashNetDB MainNet)
|
|
(PhraseDB $
|
|
Phrase
|
|
"cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest")
|
|
2200000
|
|
0
|
|
zw `shouldNotBe` Nothing
|
|
it "Save Account:" $ do
|
|
pool <- runNoLoggingT $ initPool "test.db"
|
|
s <-
|
|
runSqlite "test.db" $ do
|
|
selectList [ZcashWalletName ==. "Testing"] []
|
|
za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
|
|
za `shouldNotBe` Nothing
|
|
it "Save address:" $ do
|
|
pool <- runNoLoggingT $ initPool "test.db"
|
|
acList <-
|
|
runSqlite "test.db" $
|
|
selectList [ZcashAccountName ==. "TestAccount"] []
|
|
zAdd <-
|
|
saveAddress pool =<<
|
|
createWalletAddress "Personal123" 0 MainNet External (head acList)
|
|
addList <-
|
|
runSqlite "test.db" $
|
|
selectList
|
|
[ WalletAddressName ==. "Personal123"
|
|
, WalletAddressScope ==. ScopeDB External
|
|
]
|
|
[]
|
|
getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe`
|
|
"u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
|
|
it "Address components are correct" $ do
|
|
let ua =
|
|
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
|
isValidUnifiedAddress ua `shouldNotBe` Nothing
|
|
describe "Note selection for Tx" $ do
|
|
it "Value less than balance" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
|
res `shouldNotBe` ([], [], [])
|
|
it "Value greater than balance" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
|
res `shouldThrow` anyIOException
|
|
describe "Testing validation" $ do
|
|
it "Unified" $ do
|
|
let a =
|
|
"utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu"
|
|
True `shouldBe`
|
|
(case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just _a1 -> True
|
|
Nothing ->
|
|
isValidShieldedAddress (E.encodeUtf8 a) ||
|
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just _a3 -> True
|
|
Nothing ->
|
|
case decodeExchangeAddress (E.encodeUtf8 a) of
|
|
Just _a4 -> True
|
|
Nothing -> False))
|
|
it "Sapling" $ do
|
|
let a =
|
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
|
True `shouldBe`
|
|
(case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just _a1 -> True
|
|
Nothing ->
|
|
isValidShieldedAddress (E.encodeUtf8 a) ||
|
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just _a3 -> True
|
|
Nothing ->
|
|
case decodeExchangeAddress (E.encodeUtf8 a) of
|
|
Just _a4 -> True
|
|
Nothing -> False))
|
|
it "Transparent" $ do
|
|
let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3"
|
|
True `shouldBe`
|
|
(case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just _a1 -> True
|
|
Nothing ->
|
|
isValidShieldedAddress (E.encodeUtf8 a) ||
|
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just _a3 -> True
|
|
Nothing ->
|
|
case decodeExchangeAddress (E.encodeUtf8 a) of
|
|
Just _a4 -> True
|
|
Nothing -> False))
|
|
it "Check Sapling Address" $ do
|
|
let a =
|
|
encodeSaplingAddress TestNet $
|
|
SaplingReceiver
|
|
"Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-"
|
|
a `shouldBe`
|
|
Just
|
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
|
describe "Witnesses" $ do
|
|
describe "Sapling" $ do
|
|
it "max output id" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
sId <- getMaxSaplingNote pool
|
|
sId `shouldBe` toSqlKey 0
|
|
describe "Notes" $ do
|
|
xit "Check Orchard notes" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
|
oNotes `shouldBe` []
|
|
xit "Check Sapling notes" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
|
oNotes `shouldBe` []
|
|
xit "Check transparent notes" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
|
oNotes `shouldBe` []
|
|
describe "Tree tests" $ do
|
|
let cmx1 =
|
|
hexString
|
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
|
|
let cmx2 =
|
|
hexString
|
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07"
|
|
let t0 = EmptyLeaf <> EmptyLeaf :: Tree OrchardNode
|
|
let t1 = t0 <> EmptyLeaf :: Tree OrchardNode
|
|
let t1a = t0 <> t0
|
|
it "Create leaf" $ do
|
|
let n = leaf cmx1 0 0 :: Tree OrchardNode
|
|
getLevel (value n) `shouldBe` 0
|
|
it "Create minimal tree" $ do
|
|
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode
|
|
getLevel (value t) `shouldBe` 1
|
|
it "Create minimal empty tree" $ do
|
|
getTag (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
|
|
getTag (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
|
|
getTag (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
|
|
{-
|
|
-getTag (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
|
|
getTag (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
|
|
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"
|