Rene Vergara
0e14228a0e
Adds new `ZcashBlock` table to database to track block information and creates a relationship between `ZcashTransaction` records and the block they belong to. Database getters and setters are updated to use the block record for confirmations, height, time data.
296 lines
14 KiB
Haskell
296 lines
14 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Control.Monad (when)
|
|
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
|
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 (isValidUnifiedAddress, parseAddress)
|
|
import ZcashHaskell.Sapling
|
|
( decodeSaplingOutputEsk
|
|
, encodeSaplingAddress
|
|
, getSaplingNotePosition
|
|
, getSaplingWitness
|
|
, isValidShieldedAddress
|
|
, updateSaplingCommitmentTree
|
|
)
|
|
import ZcashHaskell.Transparent
|
|
( decodeExchangeAddress
|
|
, decodeTransparentAddress
|
|
)
|
|
import ZcashHaskell.Types
|
|
( DecodedNote(..)
|
|
, OrchardSpendingKey(..)
|
|
, Phrase(..)
|
|
, SaplingCommitmentTree(..)
|
|
, SaplingReceiver(..)
|
|
, SaplingSpendingKey(..)
|
|
, Scope(..)
|
|
, ShieldedOutput(..)
|
|
, ZcashNet(..)
|
|
)
|
|
import Zenith.Core
|
|
import Zenith.DB
|
|
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 "Function tests" $ do
|
|
describe "Sapling Decoding" $ do
|
|
let sk =
|
|
SaplingSpendingKey
|
|
"\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
|
|
let tree =
|
|
SaplingCommitmentTree $
|
|
hexString
|
|
"01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
|
let nextTree =
|
|
SaplingCommitmentTree $
|
|
hexString
|
|
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
|
|
it "Sapling is decoded correctly" $ do
|
|
so <-
|
|
runSqlite "zenith.db" $
|
|
selectList [ShieldOutputTx ==. toSqlKey 38318] []
|
|
let cmus = map (getHex . shieldOutputCmu . entityVal) so
|
|
let pos =
|
|
getSaplingNotePosition <$>
|
|
(getSaplingWitness =<<
|
|
updateSaplingCommitmentTree tree (head cmus))
|
|
let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
|
|
let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
|
|
case pos of
|
|
Nothing -> assertFailure "couldn't get note position"
|
|
Just p -> do
|
|
print p
|
|
print pos1
|
|
print pos2
|
|
let dn =
|
|
decodeSaplingOutputEsk
|
|
sk
|
|
(ShieldedOutput
|
|
(getHex $ shieldOutputCv $ entityVal $ head so)
|
|
(getHex $ shieldOutputCmu $ entityVal $ head so)
|
|
(getHex $ shieldOutputEphKey $ entityVal $ head so)
|
|
(getHex $ shieldOutputEncCipher $ entityVal $ head so)
|
|
(getHex $ shieldOutputOutCipher $ entityVal $ head so)
|
|
(getHex $ shieldOutputProof $ entityVal $ head so))
|
|
TestNet
|
|
External
|
|
p
|
|
case dn of
|
|
Nothing -> assertFailure "couldn't decode Sap output"
|
|
Just d ->
|
|
a_nullifier d `shouldBe`
|
|
hexString
|
|
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
|
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
|
|
it "Fee calculation" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
|
calculateTxFee res 3 `shouldBe` 20000
|
|
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 "Notes" $ do
|
|
it "Check Orchard notes" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
|
oNotes `shouldBe` []
|
|
it "Check Sapling notes" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 1)
|
|
oNotes `shouldBe` []
|
|
it "Check transparent notes" $ do
|
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
|
oNotes `shouldBe` []
|
|
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 1)
|
|
2999946
|
|
0.005
|
|
(fromJust uaRead)
|
|
"Sending memo to orchard"
|
|
Full
|
|
tx `shouldBe` Right (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)
|
|
2999396
|
|
0.005
|
|
(fromJust uaRead)
|
|
"Sending memo to orchard"
|
|
Full
|
|
tx `shouldBe` Right (hexString "deadbeef")
|