Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 6 Packages Wiki Activity

Merge branch 'rav001' into trees

Browse source
This commit is contained in:
Rene Vergara 2024-10-30 13:48:29 -05:00
commit e52664fa8b
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
10 changed files with 819 additions and 770 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
CHANGELOG.md
View file

@ -22,6 +22,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- `getoperationstatus` RPC method
- `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy`
- Functionality to shield transparent balance
- Functionality to de-shield shielded notes
### Changed

5
src/Zenith/CLI.hs
View file

@ -832,7 +832,7 @@ scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
syncChk <- liftIO $ isSyncing pool
if syncChk
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
@ -840,11 +840,12 @@ scanZebra dbP zHost zPort b eChan znet = do
logDebugN $
"dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
when (chkBlock /= dbBlock && chkBlock /= 1) $
rewindWalletData pool sb $ ZcashNetDB znet
if sb > zgb_blocks bStatus || sb < 1
then do
liftIO $

742
src/Zenith/Core.hs
View file

@ -23,7 +23,7 @@ import Data.Aeson
import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (HexString, toBytes)
import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
import Data.Int (Int64)
import Data.List
import Data.Maybe (fromJust, fromMaybe)
@ -116,20 +116,35 @@ checkBlockChain nodeHost nodePort = do
-- | Get commitment trees from Zebra
getCommitmentTrees ::
T.Text -- ^ Host where `zebrad` is avaiable
ConnectionPool
-> T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available
-> ZcashNetDB
-> Int -- ^ Block height
-> IO ZebraTreeInfo
getCommitmentTrees nodeHost nodePort block = do
r <-
makeZebraCall
nodeHost
nodePort
"z_gettreestate"
[Data.Aeson.String $ T.pack $ show block]
case r of
Left e -> throwIO $ userError e
Right zti -> return zti
getCommitmentTrees pool nodeHost nodePort znet block = do
bh' <- getBlockHash pool block znet
case bh' of
Nothing -> do
r <-
makeZebraCall
nodeHost
nodePort
"z_gettreestate"
[Data.Aeson.String $ T.pack $ show block]
case r of
Left e -> throwIO $ userError e
Right zti -> return zti
Just bh -> do
r <-
makeZebraCall
nodeHost
nodePort
"z_gettreestate"
[Data.Aeson.String $ toText bh]
case r of
Left e -> throwIO $ userError e
Right zti -> return zti
-- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index
@ -288,7 +303,7 @@ findSaplingOutputs config b znet za = do
let zn = getNet znet
pool <- liftIO $ runNoLoggingT $ initPool dbPath
tList <- liftIO $ getShieldedOutputs pool b znet
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
logDebugN "getting Sapling frontier"
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
case sT of
@ -395,7 +410,7 @@ findOrchardActions config b znet za = do
let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b znet
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
trees <- getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
case sT of
Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
@ -507,264 +522,271 @@ updateOrchardWitnesses pool = do
-- | Calculate fee per ZIP-317
calculateTxFee ::
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-> Int
-> Integer
calculateTxFee (t, s, o) i =
fromIntegral
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
-> [OutgoingNote]
-> Int64
calculateTxFee (t, s, o) nout =
fromIntegral $ 5000 * (tcount + saction + oaction)
where
tout =
if i == 1 || i == 2
then 1
else 0
sout =
if i == 3
then 1
else 0
oout =
if i == 4
then 1
else 0
length $
filter
(\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6)
nout
sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout
oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout
tcount = max (length t) tout
scount = max (length s) sout
ocount = max (length o) oout
saction =
if scount == 1
then 2
else scount
oaction =
if ocount == 1
then 2
else ocount
-- | Prepare a transaction for sending
prepareTx ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Scientific
-> UnifiedAddress
-> T.Text
-> LoggingT IO (Either TxError HexString)
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
accRead <- liftIO $ getAccountById pool za
let recipient =
case o_rec ua of
Nothing ->
case s_rec ua of
Nothing ->
case t_rec ua of
Nothing -> (0, "")
Just r3 ->
case tr_type r3 of
P2PKH -> (1, toBytes $ tr_bytes r3)
P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1)
logDebugN $ T.pack $ show recipient
logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> do
logErrorN "Can't find Account"
return $ Left ZHError
Just acc -> do
logDebugN $ T.pack $ show acc
let zats' = toBoundedInteger $ amt * scientific 1 8
case zats' of
Nothing -> return $ Left ZHError
Just zats -> do
logDebugN $ T.pack $ show (zats :: Int64)
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee
(tList, sList, oList) <-
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
logDebugN "selected notes"
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <-
liftIO $
prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList
--print tSpends
sSpends <-
liftIO $
prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList
--print sSpends
oSpends <-
liftIO $
prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList
--print oSpends
dummy <-
liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - 5000 - zats)
logDebugN "Calculating fee"
let feeResponse =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
dummy
zn
bh
False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
outgoing <-
liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - fromInteger feeAmt - zats)
logDebugN $ T.pack $ show outgoing
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
outgoing
zn
bh
True
logDebugN $ T.pack $ show tx
return tx
where
makeOutgoing ::
Entity ZcashAccount
-> (Int, BS.ByteString)
-> Int64
-> Int64
-> IO [OutgoingNote]
makeOutgoing acc (k, recvr) zats chg = do
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
let chgRcvr =
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return
[ OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
(fromIntegral k)
(case k of
4 ->
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
3 ->
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
_ -> "")
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
getTotalAmount ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
, [Entity WalletOrchNote])
-> Integer
getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
prepTSpends ::
TransparentSpendingKey
-> [Entity WalletTrNote]
-> IO [TransparentTxSpend]
prepTSpends sk notes = do
forM notes $ \n -> do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
case tAddRead of
Nothing -> throwIO $ userError "Couldn't read t-address"
Just tAdd -> do
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
genTransparentSecretKey
(walletAddressIndex $ entityVal tAdd)
(getScope $ walletAddressScope $ entityVal tAdd)
sk
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (ESQ.Value reverseTxId) -> do
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
return $
TransparentTxSpend
xp_key
(RawOutPoint
flipTxId
(fromIntegral $ walletTrNotePosition $ entityVal n))
(RawTxOut
(fromIntegral $ walletTrNoteValue $ entityVal n)
(walletTrNoteScript $ entityVal n))
prepSSpends ::
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
prepSSpends sk notes = do
forM notes $ \n -> do
return $
SaplingTxSpend
(getBytes sk)
(DecodedNote
(fromIntegral $ walletSapNoteValue $ entityVal n)
(walletSapNoteRecipient $ entityVal n)
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
(getHex $ walletSapNoteNullifier $ entityVal n)
""
(getRseed $ walletSapNoteRseed $ entityVal n))
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
prepOSpends ::
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
prepOSpends sk notes = do
forM notes $ \n -> do
return $
OrchardTxSpend
(getBytes sk)
(DecodedNote
(fromIntegral $ walletOrchNoteValue $ entityVal n)
(walletOrchNoteRecipient $ entityVal n)
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
(getHex $ walletOrchNoteNullifier $ entityVal n)
(walletOrchNoteRho $ entityVal n)
(getRseed $ walletOrchNoteRseed $ entityVal n))
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
sapAnchor notes =
if not (null notes)
then Just $
SaplingWitness $
getHex $ walletSapNoteWitness $ entityVal $ head notes
else Nothing
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
orchAnchor notes =
if not (null notes)
then Just $
OrchardWitness $
getHex $ walletOrchNoteWitness $ entityVal $ head notes
else Nothing
{-
-prepareTx ::
- ConnectionPool
- -> T.Text
- -> Int
- -> ZcashNet
- -> ZcashAccountId
- -> Int
- -> Scientific
- -> UnifiedAddress
- -> T.Text
- -> LoggingT IO (Either TxError HexString)
-prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
- accRead <- liftIO $ getAccountById pool za
- let recipient =
- case o_rec ua of
- Nothing ->
- case s_rec ua of
- Nothing ->
- case t_rec ua of
- Nothing -> (0, "")
- Just r3 ->
- case tr_type r3 of
- P2PKH -> (1, toBytes $ tr_bytes r3)
- P2SH -> (2, toBytes $ tr_bytes r3)
- Just r2 -> (3, getBytes r2)
- Just r1 -> (4, getBytes r1)
- logDebugN $ T.pack $ show recipient
- logDebugN $ T.pack $ "Target block: " ++ show bh
- trees <-
- liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
- let sT = SaplingCommitmentTree $ ztiSapling trees
- let oT = OrchardCommitmentTree $ ztiOrchard trees
- case accRead of
- Nothing -> do
- logErrorN "Can't find Account"
- return $ Left ZHError
- Just acc -> do
- logDebugN $ T.pack $ show acc
- let zats' = toBoundedInteger $ amt * scientific 1 8
- case zats' of
- Nothing -> return $ Left ZHError
- Just zats -> do
- logDebugN $ T.pack $ show (zats :: Int64)
- {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
- --let fee = calculateTxFee firstPass $ fst recipient
- --logDebugN $ T.pack $ "calculated fee " ++ show fee
- (tList, sList, oList) <-
- liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
- logDebugN "selected notes"
- logDebugN $ T.pack $ show tList
- logDebugN $ T.pack $ show sList
- logDebugN $ T.pack $ show oList
- let noteTotal = getTotalAmount (tList, sList, oList)
- tSpends <-
- liftIO $
- prepTSpends
- (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
- tList
- --print tSpends
- sSpends <-
- liftIO $
- prepSSpends
- (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
- sList
- --print sSpends
- oSpends <-
- liftIO $
- prepOSpends
- (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
- oList
- --print oSpends
- dummy <-
- liftIO $
- makeOutgoing
- acc
- recipient
- zats
- (fromInteger noteTotal - 5000 - zats)
- logDebugN "Calculating fee"
- let feeResponse =
- createTransaction
- (Just sT)
- (Just oT)
- tSpends
- sSpends
- oSpends
- dummy
- zn
- bh
- False
- case feeResponse of
- Left e1 -> return $ Left Fee
- Right fee -> do
- let feeAmt =
- fromIntegral
- (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
- (tList1, sList1, oList1) <-
- liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
- logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
- logDebugN $ T.pack $ show tList
- logDebugN $ T.pack $ show sList
- logDebugN $ T.pack $ show oList
- outgoing <-
- liftIO $
- makeOutgoing
- acc
- recipient
- zats
- (fromInteger noteTotal - fromInteger feeAmt - zats)
- logDebugN $ T.pack $ show outgoing
- let tx =
- createTransaction
- (Just sT)
- (Just oT)
- tSpends
- sSpends
- oSpends
- outgoing
- zn
- bh
- True
- logDebugN $ T.pack $ show tx
- return tx
- where
- makeOutgoing ::
- Entity ZcashAccount
- -> (Int, BS.ByteString)
- -> Int64
- -> Int64
- -> IO [OutgoingNote]
- makeOutgoing acc (k, recvr) zats chg = do
- chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
- let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
- let chgRcvr =
- fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
- return
- [ OutgoingNote
- 4
- (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
- (getBytes chgRcvr)
- (fromIntegral chg)
- ""
- True
- , OutgoingNote
- (fromIntegral k)
- (case k of
- 4 ->
- getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
- 3 ->
- getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
- _ -> "")
- recvr
- (fromIntegral zats)
- (E.encodeUtf8 memo)
- False
- ]
- getTotalAmount ::
- ( [Entity WalletTrNote]
- , [Entity WalletSapNote]
- , [Entity WalletOrchNote])
- -> Integer
- getTotalAmount (t, s, o) =
- sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
- sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
- sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
- prepTSpends ::
- TransparentSpendingKey
- -> [Entity WalletTrNote]
- -> IO [TransparentTxSpend]
- prepTSpends sk notes = do
- forM notes $ \n -> do
- tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
- case tAddRead of
- Nothing -> throwIO $ userError "Couldn't read t-address"
- Just tAdd -> do
- (XPrvKey _ _ _ _ (SecKey xp_key)) <-
- genTransparentSecretKey
- (walletAddressIndex $ entityVal tAdd)
- (getScope $ walletAddressScope $ entityVal tAdd)
- sk
- mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
- case mReverseTxId of
- Nothing -> throwIO $ userError "failed to get tx ID"
- Just (ESQ.Value reverseTxId) -> do
- let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
- return $
- TransparentTxSpend
- xp_key
- (RawOutPoint
- flipTxId
- (fromIntegral $ walletTrNotePosition $ entityVal n))
- (RawTxOut
- (fromIntegral $ walletTrNoteValue $ entityVal n)
- (walletTrNoteScript $ entityVal n))
- prepSSpends ::
- SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
- prepSSpends sk notes = do
- forM notes $ \n -> do
- return $
- SaplingTxSpend
- (getBytes sk)
- (DecodedNote
- (fromIntegral $ walletSapNoteValue $ entityVal n)
- (walletSapNoteRecipient $ entityVal n)
- (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
- (getHex $ walletSapNoteNullifier $ entityVal n)
- ""
- (getRseed $ walletSapNoteRseed $ entityVal n))
- (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
- prepOSpends ::
- OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
- prepOSpends sk notes = do
- forM notes $ \n -> do
- return $
- OrchardTxSpend
- (getBytes sk)
- (DecodedNote
- (fromIntegral $ walletOrchNoteValue $ entityVal n)
- (walletOrchNoteRecipient $ entityVal n)
- (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
- (getHex $ walletOrchNoteNullifier $ entityVal n)
- (walletOrchNoteRho $ entityVal n)
- (getRseed $ walletOrchNoteRseed $ entityVal n))
- (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
- sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
- sapAnchor notes =
- if not (null notes)
- then Just $
- SaplingWitness $
- getHex $ walletSapNoteWitness $ entityVal $ head notes
- else Nothing
- orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
- orchAnchor notes =
- if not (null notes)
- then Just $
- OrchardWitness $
- getHex $ walletOrchNoteWitness $ entityVal $ head notes
- else Nothing
-}
deshieldNotes ::
ConnectionPool
-> T.Text
@ -811,7 +833,6 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
dRecvs
forM fNotes $ \trNotes -> do
let noteTotal = getTotalAmount (trNotes, [], [])
let fee = calculateTxFee (trNotes, [], []) 4
tSpends <-
liftIO $
prepTSpends
@ -823,25 +844,35 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
let oRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let dummy =
OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr)
(fromIntegral $ noteTotal - 500)
""
True
let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
let snote =
OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr)
(fromIntegral $ noteTotal - fee)
(fromIntegral $ noteTotal - fromIntegral feeAmt)
""
True
let tx =
createTransaction
Nothing
Nothing
tSpends
[]
[]
[snote]
znet
(bh + 3)
True
tx <-
liftIO $
createTransaction
Nothing
Nothing
tSpends
[]
[]
[snote]
znet
(bh + 3)
True
logDebugN $ T.pack $ show tx
return tx
where
@ -900,11 +931,10 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
let recipients = map extractReceiver pnotes
logDebugN $ T.pack $ show recipients
logDebugN $ T.pack $ "Target block: " ++ show bh
{-
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
-let sT = SaplingCommitmentTree $ ztiSapling trees
-let oT = OrchardCommitmentTree $ ztiOrchard trees
-}
trees <-
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> do
logErrorN "Can't find Account"
@ -928,7 +958,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
selectUnspentNotesV2
pool
za
(zats + 10000)
(zats + 20000)
(map (\(x, _, _, _) -> x) recipients)
policy
case notePlan of
@ -957,94 +987,74 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList
--print oSpends
dummy' <-
draft <-
liftIO $
makeOutgoing
acc
recipients
(noteTotal - 5000 - fromIntegral zats)
policy
case dummy' of
case draft of
Left e -> return $ Left e
Right dummy -> do
logDebugN "Calculating fee"
let feeResponse =
createTransaction
Nothing
Nothing
tSpends
sSpends
oSpends
dummy
zn
bh
False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
finalNotePlan <-
Right draftOut -> do
let fee = calculateTxFee (tList, sList, oList) draftOut
logDebugN $ T.pack $ "calculated fee " ++ show fee
finalNotePlan <-
liftIO $
selectUnspentNotesV2
pool
za
(zats + fee)
(map (\(x, _, _, _) -> x) recipients)
policy
case finalNotePlan of
Right (tList1, sList1, oList1) -> do
logDebugN $ T.pack $ "selected notes with fee" ++ show fee
logDebugN $ T.pack $ show tList1
logDebugN $ T.pack $ show sList1
logDebugN $ T.pack $ show oList1
tSpends1 <-
liftIO $
selectUnspentNotesV2
pool
za
(fromIntegral zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients)
prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList1
sSpends1 <-
liftIO $
prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList1
oSpends1 <-
liftIO $
prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList1
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
outgoing' <-
liftIO $
makeOutgoing
acc
recipients
(noteTotal1 - fee - fromIntegral zats)
policy
case finalNotePlan of
Right (tList1, sList1, oList1) -> do
logDebugN $
T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList1
logDebugN $ T.pack $ show sList1
logDebugN $ T.pack $ show oList1
tSpends1 <-
liftIO $
prepTSpends
(getTranSK $
zcashAccountTPrivateKey $ entityVal acc)
tList1
sSpends1 <-
liftIO $
prepSSpends
(getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
sList1
oSpends1 <-
liftIO $
prepOSpends
(getOrchSK $
zcashAccountOrchSpendKey $ entityVal acc)
oList1
let noteTotal1 =
getTotalAmount (tList1, sList1, oList1)
outgoing' <-
liftIO $
makeOutgoing
acc
recipients
(noteTotal1 - feeAmt - fromIntegral zats)
policy
logDebugN $ T.pack $ show outgoing'
case outgoing' of
Left e -> return $ Left e
Right outgoing -> do
let tx =
createTransaction
Nothing
Nothing
tSpends1
sSpends1
oSpends1
outgoing
zn
bh
True
logDebugN $ T.pack $ show tx
return tx
logDebugN $ T.pack $ show outgoing'
case outgoing' of
Left e -> return $ Left e
Right outgoing -> do
tx <-
liftIO $
createTransaction
(Just sT)
(Just oT)
tSpends1
sSpends1
oSpends1
outgoing
zn
bh
True
logDebugN $ T.pack $ show tx
return tx
Left e -> return $ Left e
Left e -> do
logErrorN $ T.pack $ show e
return $ Left e
@ -1360,7 +1370,7 @@ syncWallet config w = do
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
else 1 + zcashWalletBirthdayHeight (entityVal w)
logDebugN $ "start block: " <> T.pack (show startBlock)
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs

58
src/Zenith/DB.hs
View file

@ -698,22 +698,42 @@ saveAddress pool w =
runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
-- * Block
-- | Save a block to the database
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
saveBlock pool b =
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
-- | Read a block by height
getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
getBlock pool b =
getBlock ::
ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
getBlock pool b znet =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
bl <- from $ table @ZcashBlock
where_ $ bl ^. ZcashBlockHeight ==. val b
where_ $
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure bl
getBlockHash :: ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe HexString)
getBlockHash pool b znet = do
r <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
bl <- from $ table @ZcashBlock
where_ $
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure $ bl ^. ZcashBlockHash
case r of
Nothing -> return Nothing
Just (Value h) -> return $ Just $ getHex h
-- | Save a transaction to the data model
saveTransaction ::
ConnectionPool -- ^ the database path
@ -2648,8 +2668,8 @@ completeSync pool st = do
return ()
-- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
rewindWalletData pool b = do
rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
rewindWalletData pool b net = do
logDebugN "Starting transaction rewind"
liftIO $ clearWalletTransactions pool
logDebugN "Completed transaction rewind"
@ -2661,7 +2681,9 @@ rewindWalletData pool b = do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
@ -2681,7 +2703,9 @@ rewindWalletData pool b = do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
@ -2701,7 +2725,9 @@ rewindWalletData pool b = do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
@ -2721,7 +2747,9 @@ rewindWalletData pool b = do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
@ -2741,7 +2769,9 @@ rewindWalletData pool b = do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
@ -2761,7 +2791,9 @@ rewindWalletData pool b = do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
@ -2780,5 +2812,7 @@ rewindWalletData pool b = do
flip PS.runSqlPool pool $ do
delete $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
logDebugN "Completed data store rewind"

6
src/Zenith/GUI.hs
View file

@ -1627,17 +1627,17 @@ scanZebra dbPath zHost zPort net sendMsg = do
pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool
if syncChk
then sendMsg (ShowError "Sync already in progress")
else do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
if sb > zgb_blocks bStatus || sb < 1
then sendMsg (ShowError "Invalid starting block for scan")
else do

6
src/Zenith/RPC.hs
View file

@ -889,15 +889,15 @@ scanZebra dbPath zHost zPort net = do
pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool
unless syncChk $ do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do

9
src/Zenith/Scanner.hs
View file

@ -246,10 +246,11 @@ checkIntegrity ::
T.Text -- ^ Database path
-> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port
-> ZcashNet -- ^ the network to scan
-> Int -- ^ The block to start the check
-> Int -- ^ depth
-> IO Int
checkIntegrity dbP zHost zPort b d =
checkIntegrity dbP zHost zPort znet b d =
if b < 1
then return 1
else do
@ -263,10 +264,10 @@ checkIntegrity dbP zHost zPort b d =
Left e -> throwIO $ userError e
Right blk -> do
pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b
dbBlk <- getBlock pool b $ ZcashNetDB znet
case dbBlk of
Nothing -> throwIO $ userError "Block mismatch, rescan needed"
Nothing -> return 1
Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b
else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)

758
test/Spec.hs
View file

@ -2,6 +2,7 @@
import Control.Monad (when)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Data.HexString
import Data.Maybe (fromJust)
import qualified Data.Text.Encoding as E
@ -43,7 +44,7 @@ import ZcashHaskell.Types
, ValidAddress(..)
, ZcashNet(..)
)
import ZcashHaskell.Utils (readZebraTransaction)
import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
import Zenith.Core
import Zenith.DB
import Zenith.Tree
@ -211,384 +212,6 @@ main = 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 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 `shouldBe` (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 "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
]
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")
describe "Tree tests" $ do
let cmx1 =
hexString
@ -636,3 +259,380 @@ main = do
Just t1 -> do
let t = root $ mkOrchardTree t1
getTag (value t) `shouldBe` getOrchardTreeAnchor 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"

2
zcash-haskell

@ -1 +1 @@
Subproject commit b6d490d05300a9db9cdf9929baa9b984bee9f3f6
Subproject commit f6b8a772770f492221dc99281016d7090f981e63

1
zenith.cabal
View file

@ -142,6 +142,7 @@ test-suite zenith-tests
build-depends:
base >=4.12 && <5
, bytestring
, aeson
, configurator
, monad-logger
, aeson