zenith/test/Spec.hs

254 lines
12 KiB
Haskell
Raw Normal View History

2024-01-22 18:58:37 +00:00
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when)
2024-05-09 15:44:07 +00:00
import Control.Monad.Logger (runNoLoggingT)
import Data.HexString
2024-05-09 15:44:07 +00:00
import qualified Data.Text.Encoding as E
2024-01-22 18:58:37 +00:00
import Database.Persist
import Database.Persist.Sqlite
import System.Directory
2024-04-07 14:25:25 +00:00
import Test.HUnit
2024-01-22 18:58:37 +00:00
import Test.Hspec
2024-03-17 12:17:52 +00:00
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling
( decodeSaplingOutputEsk
2024-05-09 15:44:07 +00:00
, encodeSaplingAddress
, getSaplingNotePosition
, getSaplingWitness
2024-05-09 15:44:07 +00:00
, isValidShieldedAddress
, updateSaplingCommitmentTree
)
2024-05-09 15:44:07 +00:00
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
2024-03-17 12:17:52 +00:00
import ZcashHaskell.Types
( DecodedNote(..)
, OrchardSpendingKey(..)
2024-03-17 12:17:52 +00:00
, Phrase(..)
, SaplingCommitmentTree(..)
2024-05-09 15:44:07 +00:00
, SaplingReceiver(..)
2024-03-17 12:17:52 +00:00
, SaplingSpendingKey(..)
, Scope(..)
, ShieldedOutput(..)
2024-03-17 12:17:52 +00:00
, ZcashNet(..)
)
import Zenith.Core
2024-01-22 18:58:37 +00:00
import Zenith.DB
2024-03-17 12:17:52 +00:00
import Zenith.Types
2024-01-22 18:58:37 +00:00
2022-06-20 21:46:13 +00:00
main :: IO ()
2024-01-22 18:58:37 +00:00
main = do
checkDbFile <- doesFileExist "test.db"
when checkDbFile $ removeFile "test.db"
2024-01-22 18:58:37 +00:00
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"
2024-03-17 12:17:52 +00:00
(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
2024-03-17 12:17:52 +00:00
describe "Wallet function tests:" $ do
it "Save Wallet:" $ do
2024-05-09 15:44:07 +00:00
pool <- runNoLoggingT $ initPool "test.db"
2024-03-17 12:17:52 +00:00
zw <-
2024-05-09 15:44:07 +00:00
saveWallet pool $
2024-03-17 12:17:52 +00:00
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
2024-03-17 12:17:52 +00:00
zw `shouldNotBe` Nothing
it "Save Account:" $ do
2024-05-09 15:44:07 +00:00
pool <- runNoLoggingT $ initPool "test.db"
s <-
runSqlite "test.db" $ do
2024-03-17 12:17:52 +00:00
selectList [ZcashWalletName ==. "Testing"] []
2024-05-09 15:44:07 +00:00
za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
2024-03-17 12:17:52 +00:00
za `shouldNotBe` Nothing
it "Save address:" $ do
2024-05-09 15:44:07 +00:00
pool <- runNoLoggingT $ initPool "test.db"
2024-03-17 12:17:52 +00:00
acList <-
runSqlite "test.db" $
selectList [ZcashAccountName ==. "TestAccount"] []
zAdd <-
2024-05-09 15:44:07 +00:00
saveAddress pool =<<
2024-03-17 12:17:52 +00:00
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
2024-04-07 14:25:25 +00:00
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"
2024-05-03 12:10:08 +00:00
describe "Note selection for Tx" $ do
it "Value less than balance" $ do
2024-05-09 15:44:07 +00:00
pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
2024-05-03 12:10:08 +00:00
res `shouldNotBe` ([], [], [])
it "Value greater than balance" $ do
2024-05-09 15:44:07 +00:00
pool <- runNoLoggingT $ initPool "zenith.db"
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
2024-05-03 12:10:08 +00:00
res `shouldThrow` anyIOException
it "Fee calculation" $ do
2024-05-09 15:44:07 +00:00
pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
2024-05-03 12:10:08 +00:00
calculateTxFee res 3 `shouldBe` 20000
2024-05-09 15:44:07 +00:00
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 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 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 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 "Creating Tx" $ do-}
{-xit "To Orchard" $ do-}
{-let uaRead =-}
{-isValidUnifiedAddress-}
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
{-case uaRead of-}
{-Nothing -> assertFailure "wrong address"-}
{-Just ua -> do-}
{-tx <--}
{-prepareTx-}
{-"zenith.db"-}
{-TestNet-}
{-(toSqlKey 1)-}
{-2819811-}
{-0.04-}
{-ua-}
{-"sent with Zenith, test"-}
{-tx `shouldBe` Right (hexString "deadbeef")-}