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 - `getoperationstatus` RPC method
- `sendmany` RPC method - `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy` - Function `prepareTxV2` implementing `PrivacyPolicy`
- Functionality to shield transparent balance
- Functionality to de-shield shielded notes
### Changed ### 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 bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet 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 syncChk <- liftIO $ isSyncing pool
if syncChk if syncChk
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress" then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
@ -840,11 +840,12 @@ scanZebra dbP zHost zPort b eChan znet = do
logDebugN $ logDebugN $
"dbBlock: " <> "dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
when (chkBlock /= dbBlock && chkBlock /= 1) $
rewindWalletData pool sb $ ZcashNetDB znet
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ liftIO $

620
src/Zenith/Core.hs
View file

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

58
src/Zenith/DB.hs
View file

@ -698,22 +698,42 @@ saveAddress pool w =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
-- * Block
-- | Save a block to the database -- | Save a block to the database
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock) saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
saveBlock pool b = saveBlock pool b =
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
-- | Read a block by height -- | Read a block by height
getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock)) getBlock ::
getBlock pool b = ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
getBlock pool b znet =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
bl <- from $ table @ZcashBlock bl <- from $ table @ZcashBlock
where_ $ bl ^. ZcashBlockHeight ==. val b where_ $
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure bl 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 -- | Save a transaction to the data model
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path
@ -2648,8 +2668,8 @@ completeSync pool st = do
return () return ()
-- | Rewind the data store to a given block height -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> LoggingT IO () rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
rewindWalletData pool b = do rewindWalletData pool b net = do
logDebugN "Starting transaction rewind" logDebugN "Starting transaction rewind"
liftIO $ clearWalletTransactions pool liftIO $ clearWalletTransactions pool
logDebugN "Completed transaction rewind" logDebugN "Completed transaction rewind"
@ -2661,7 +2681,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2681,7 +2703,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2701,7 +2725,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2721,7 +2747,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2741,7 +2769,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2761,7 +2791,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2780,5 +2812,7 @@ rewindWalletData pool b = do
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
delete $ do delete $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
logDebugN "Completed data store rewind" 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 pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool syncChk <- isSyncing pool
if syncChk if syncChk
then sendMsg (ShowError "Sync already in progress") then sendMsg (ShowError "Sync already in progress")
else do else do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then sendMsg (ShowError "Invalid starting block for scan") then sendMsg (ShowError "Invalid starting block for scan")
else do else do

6
src/Zenith/RPC.hs
View file

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

9
src/Zenith/Scanner.hs
View file

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

110
test/Spec.hs
View file

@ -2,6 +2,7 @@
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Data.HexString import Data.HexString
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -43,7 +44,7 @@ import ZcashHaskell.Types
, ValidAddress(..) , ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (readZebraTransaction) import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Tree import Zenith.Tree
@ -211,6 +212,53 @@ main = do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1) oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
oNotes `shouldBe` [] oNotes `shouldBe` []
describe "Tree tests" $ do
let cmx1 =
hexString
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
let t0 = EmptyLeaf <> EmptyLeaf :: Tree OrchardNode
let t1 = t0 <> EmptyLeaf :: Tree OrchardNode
let t1a = t0 <> t0
it "Create leaf" $ do
let n = leaf cmx1 1 :: Tree OrchardNode
getLevel (value n) `shouldBe` 0
it "Create minimal tree" $ do
let t = (leaf cmx1 1) <> 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" $ mkSubTree 2 EmptyLeaf `shouldBe` t1
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
it "Create a tree from Frontier" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
case getOrchardFrontier tree of
Nothing -> assertFailure "Failed to get frontier"
Just t1 -> do
of_ommers t1 `shouldBe` []
it "Validate a tree's depth from Frontier" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
case getOrchardFrontier tree of
Nothing -> assertFailure "Failed to get frontier"
Just t1 -> do
let t = root $ mkOrchardTree t1
getLevel (value t) `shouldBe` 31
it "Validate a tree from Frontier" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
case getOrchardFrontier tree of
Nothing -> assertFailure "Failed to get frontier"
Just t1 -> do
let t = root $ mkOrchardTree t1
getTag (value t) `shouldBe` getOrchardTreeAnchor t1
describe "Creating Tx" $ do describe "Creating Tx" $ do
describe "Full" $ do describe "Full" $ do
it "To Orchard" $ do it "To Orchard" $ do
@ -238,7 +286,7 @@ main = do
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldBe` (hexString "deadbeef") Right h -> h `shouldNotBe` hexString "deadbeef"
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -264,7 +312,7 @@ main = do
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") Right h -> h `shouldNotBe` hexString "deadbeef"
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
@ -287,8 +335,7 @@ main = do
] ]
Full Full
tx `shouldBe` tx `shouldBe`
Left Left (PrivacyPolicyError "Receiver not capable of Full privacy")
(PrivacyPolicyError "Receiver not capable of Full privacy")
it "To mixed shielded receivers" $ do it "To mixed shielded receivers" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -349,7 +396,7 @@ main = do
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") Right h -> h `shouldNotBe` hexString "deadbeef"
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -375,7 +422,7 @@ main = do
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") Right h -> h `shouldNotBe` (hexString "00")
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
@ -588,51 +635,4 @@ main = do
None None
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") Right h -> h `shouldNotBe` hexString "deadbeef"
describe "Tree tests" $ do
let cmx1 =
hexString
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
let t0 = EmptyLeaf <> EmptyLeaf :: Tree OrchardNode
let t1 = t0 <> EmptyLeaf :: Tree OrchardNode
let t1a = t0 <> t0
it "Create leaf" $ do
let n = leaf cmx1 1 :: Tree OrchardNode
getLevel (value n) `shouldBe` 0
it "Create minimal tree" $ do
let t = (leaf cmx1 1) <> 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" $ mkSubTree 2 EmptyLeaf `shouldBe` t1
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
it "Create a tree from Frontier" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
case getOrchardFrontier tree of
Nothing -> assertFailure "Failed to get frontier"
Just t1 -> do
of_ommers t1 `shouldBe` []
it "Validate a tree's depth from Frontier" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
case getOrchardFrontier tree of
Nothing -> assertFailure "Failed to get frontier"
Just t1 -> do
let t = root $ mkOrchardTree t1
getLevel (value t) `shouldBe` 31
it "Validate a tree from Frontier" $ do
let tree =
OrchardCommitmentTree $
hexString
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
case getOrchardFrontier tree of
Nothing -> assertFailure "Failed to get frontier"
Just t1 -> do
let t = root $ mkOrchardTree t1
getTag (value t) `shouldBe` getOrchardTreeAnchor t1

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: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, aeson
, configurator , configurator
, monad-logger , monad-logger
, aeson , aeson