2024-05-09 19:15:37 +00:00
{- # LANGUAGE OverloadedStrings # -}
import Control.Monad ( when )
import Control.Monad.Logger ( runNoLoggingT )
import Data.HexString
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 )
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
2022-06-20 21:46:13 +00:00
main :: IO ()
2024-05-09 19:15:37 +00:00
main = do
checkDbFile <- doesFileExist " test.db "
when checkDbFile $ removeFile " test.db "
hspec $ do
describe " Database tests " $ do
it " Create table " $ do
s <- runSqlite " test.db " $ do runMigration migrateAll
s ` shouldBe ` ()
describe " Wallet Table " $ do
it " insert wallet record " $ do
s <-
runSqlite " test.db " $ do
insert $
ZcashWallet
" Main Wallet "
( ZcashNetDB MainNet )
( PhraseDB $
Phrase
" one two three four five six seven eight nine ten eleven twelve " )
2000000
0
fromSqlKey s ` shouldBe ` 1
it " read wallet record " $ do
s <-
runSqlite " test.db " $ do
selectList [ ZcashWalletBirthdayHeight >. 0 ] []
length s ` shouldBe ` 1
it " modify wallet record " $ do
s <-
runSqlite " test.db " $ do
let recId = toSqlKey 1 :: ZcashWalletId
update recId [ ZcashWalletName =. " New Wallet " ]
get recId
" New Wallet " ` shouldBe ` maybe " None " zcashWalletName s
it " delete wallet record " $ do
s <-
runSqlite " test.db " $ do
let recId = toSqlKey 1 :: ZcashWalletId
delete recId
get recId
" None " ` shouldBe ` maybe " None " zcashWalletName s
describe " Wallet function tests: " $ do
it " Save Wallet: " $ do
pool <- runNoLoggingT $ initPool " test.db "
zw <-
saveWallet pool $
ZcashWallet
" Testing "
( ZcashNetDB MainNet )
( PhraseDB $
Phrase
" cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest " )
2200000
0
zw ` shouldNotBe ` Nothing
it " Save Account: " $ do
pool <- runNoLoggingT $ initPool " test.db "
s <-
runSqlite " test.db " $ do
selectList [ ZcashWalletName ==. " Testing " ] []
za <- saveAccount pool =<< createZcashAccount " TestAccount " 0 ( head s )
za ` shouldNotBe ` Nothing
it " Save address: " $ do
pool <- runNoLoggingT $ initPool " test.db "
acList <-
runSqlite " test.db " $
selectList [ ZcashAccountName ==. " TestAccount " ] []
zAdd <-
saveAddress pool =<<
createWalletAddress " Personal123 " 0 MainNet External ( head acList )
addList <-
runSqlite " test.db " $
selectList
[ WalletAddressName ==. " Personal123 "
, WalletAddressScope ==. ScopeDB External
]
[]
getUA ( walletAddressUAddress ( entityVal $ head addList ) ) ` shouldBe `
" u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m "
it " Address components are correct " $ do
let ua =
" utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x "
isValidUnifiedAddress ua ` shouldNotBe ` Nothing
describe " Function tests " $ do
describe " Sapling Decoding " $ do
let sk =
SaplingSpendingKey
" \ ETX } \ 195 . \ SUB \ NUL \ NUL \ NUL \ 128 \ NUL \ 203 \ " \ 229 IL \ CAN J* \ 209 \ EM \ 145 \ 228 m \ 172 \ & 4 \ SYN Nl \ DC3 \ 161 \ 147 \ SO \ 157 \ 238 H \ 192 \ 147 eQ \ 143 L \ 201 \ 216 \ 163 \ 180 \ 147 \ 145 \ 156 Zs+ \ 146 >8 \ 176 `ta \ 161 \ 223 \ SO \ 140 \ 177 \ b ; \ 161 \ SO \ 236 \ 151 W \ 148 < \ STX \ 171 | \ DC2 \ 172 U \ 195 (I \ 140 \ 146 \ 214 \ 182 \ 137 \ 211 \ 228 \ 159 \ 128 ~bV \ STX y{m' \ 224 \ 175 \ 221 \ 219 \ 180 ! \ ENQ _ \ 161 \ 132 \ 240 ? \ 255 \ 236 \ " 6 \ 133 \ 181 \ 170 t \ 181 \ 139 \ 143 \ 207 \ 170 \ 211 \ ENQ \ 167 a \ 184 \ 163 \ 243 \ 246 \ 140 \ 158 t \ 155 \ 133 \ 138 X \ a \ 241 \ 200 \ 140 \ EM T \ GS ~ \ 175 \ 249 &z \ 250 \ 214 \ 231 \ 239 mi \ 223 \ 206 \ STX \ t \ EM <{V~J \ 253 FB "
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 " zenith.db "
res <- selectUnspentNotes pool ( toSqlKey 1 ) 14000000
res ` shouldNotBe ` ( [] , [] , [] )
it " Value greater than balance " $ do
pool <- runNoLoggingT $ initPool " zenith.db "
let res = selectUnspentNotes pool ( toSqlKey 1 ) 84000000
res ` shouldThrow ` anyIOException
it " Fee calculation " $ do
pool <- runNoLoggingT $ initPool " 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 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 \ 137 Hp< \ 221 \ 166 \ 146 \ SOH \ 196 \ 172 ,3< \ 255 \ 181 \ 195 / \ 239 \ 170 \ 158 \ 208 O \ 217 \ 197 \ DC3 \ 197 \ ESC \ n \ NUL - "
a ` shouldBe `
Just
" ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4 "
{- 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") -}