Compare commits
3 commits
f2f18b5b0c
...
f23c222edc
| Author | SHA1 | Date | |
|---|---|---|---|
f23c222edc
|
|||
|
8986847679
|
|||
|
b4a2e5e984
|
9 changed files with 991 additions and 382 deletions
|
|
@ -870,9 +870,16 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
BC.writeBChan eChan $
|
BC.writeBChan eChan $
|
||||||
TickMsg "Failed to update unconfirmed transactions"
|
TickMsg "Failed to update unconfirmed transactions"
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
|
logDebugN "Updated confirmations"
|
||||||
|
logDebugN "Starting commitment tree update"
|
||||||
|
_ <- updateCommitmentTrees pool zHost zPort (ZcashNetDB znet)
|
||||||
|
logDebugN "Finished tree update"
|
||||||
_ <- liftIO $ completeSync pool Successful
|
_ <- liftIO $ completeSync pool Successful
|
||||||
|
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
||||||
return ()
|
return ()
|
||||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
else do
|
||||||
|
liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||||
|
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
||||||
where
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock pool step bl = do
|
processBlock pool step bl = do
|
||||||
|
|
@ -920,28 +927,8 @@ appEvent (BT.AppEvent t) = do
|
||||||
TickMsg m -> do
|
TickMsg m -> do
|
||||||
case s ^. displayBox of
|
case s ^. displayBox of
|
||||||
AddrDisplay -> return ()
|
AddrDisplay -> return ()
|
||||||
MsgDisplay -> return ()
|
MsgDisplay -> do
|
||||||
PhraseDisplay -> return ()
|
if m == "startSync"
|
||||||
TxDisplay -> return ()
|
|
||||||
TxIdDisplay -> return ()
|
|
||||||
SyncDisplay -> return ()
|
|
||||||
SendDisplay -> BT.modify $ set msg m
|
|
||||||
AdrBookEntryDisplay -> return ()
|
|
||||||
BlankDisplay -> return ()
|
|
||||||
TickTx txid -> do
|
|
||||||
BT.modify $ set sentTx (Just txid)
|
|
||||||
BT.modify $ set displayBox TxIdDisplay
|
|
||||||
TickVal v -> do
|
|
||||||
case s ^. displayBox of
|
|
||||||
AddrDisplay -> return ()
|
|
||||||
MsgDisplay -> return ()
|
|
||||||
PhraseDisplay -> return ()
|
|
||||||
TxDisplay -> return ()
|
|
||||||
TxIdDisplay -> return ()
|
|
||||||
SendDisplay -> return ()
|
|
||||||
AdrBookEntryDisplay -> return ()
|
|
||||||
SyncDisplay -> do
|
|
||||||
if s ^. barValue == 1.0
|
|
||||||
then do
|
then do
|
||||||
selWallet <-
|
selWallet <-
|
||||||
do case L.listSelectedElement $ s ^. wallets of
|
do case L.listSelectedElement $ s ^. wallets of
|
||||||
|
|
@ -968,8 +955,34 @@ appEvent (BT.AppEvent t) = do
|
||||||
updatedState <- BT.get
|
updatedState <- BT.get
|
||||||
ns <- liftIO $ refreshWallet updatedState
|
ns <- liftIO $ refreshWallet updatedState
|
||||||
BT.put ns
|
BT.put ns
|
||||||
|
BT.modify $ set msg ""
|
||||||
BT.modify $ set displayBox BlankDisplay
|
BT.modify $ set displayBox BlankDisplay
|
||||||
|
else return ()
|
||||||
|
PhraseDisplay -> return ()
|
||||||
|
TxDisplay -> return ()
|
||||||
|
TxIdDisplay -> return ()
|
||||||
|
SyncDisplay -> return ()
|
||||||
|
SendDisplay -> BT.modify $ set msg m
|
||||||
|
AdrBookEntryDisplay -> return ()
|
||||||
|
BlankDisplay -> return ()
|
||||||
|
TickTx txid -> do
|
||||||
|
BT.modify $ set sentTx (Just txid)
|
||||||
|
BT.modify $ set displayBox TxIdDisplay
|
||||||
|
TickVal v -> do
|
||||||
|
case s ^. displayBox of
|
||||||
|
AddrDisplay -> return ()
|
||||||
|
MsgDisplay -> return ()
|
||||||
|
PhraseDisplay -> return ()
|
||||||
|
TxDisplay -> return ()
|
||||||
|
TxIdDisplay -> return ()
|
||||||
|
SendDisplay -> return ()
|
||||||
|
AdrBookEntryDisplay -> return ()
|
||||||
|
SyncDisplay -> do
|
||||||
|
if s ^. barValue == 1.0
|
||||||
|
then do
|
||||||
|
BT.modify $ set msg "Decoding, please wait..."
|
||||||
BT.modify $ set barValue 0.0
|
BT.modify $ set barValue 0.0
|
||||||
|
BT.modify $ set displayBox MsgDisplay
|
||||||
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
|
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
|
||||||
BlankDisplay -> do
|
BlankDisplay -> do
|
||||||
case s ^. dialogBox of
|
case s ^. dialogBox of
|
||||||
|
|
@ -990,7 +1003,9 @@ appEvent (BT.AppEvent t) = do
|
||||||
then do
|
then do
|
||||||
BT.modify $ set barValue 0.0
|
BT.modify $ set barValue 0.0
|
||||||
BT.modify $ set displayBox SyncDisplay
|
BT.modify $ set displayBox SyncDisplay
|
||||||
sBlock <- liftIO $ getMinBirthdayHeight pool
|
sBlock <-
|
||||||
|
liftIO $
|
||||||
|
getMinBirthdayHeight pool (ZcashNetDB $ s ^. network)
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
forkIO $
|
forkIO $
|
||||||
|
|
@ -1215,7 +1230,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
(s ^. zebraPort)
|
(s ^. zebraPort)
|
||||||
(s ^. network)
|
(s ^. network)
|
||||||
(entityKey selAcc)
|
(entityKey selAcc)
|
||||||
(bl + 5)
|
bl
|
||||||
(fs1 ^. sendAmt)
|
(fs1 ^. sendAmt)
|
||||||
(fs1 ^. sendTo)
|
(fs1 ^. sendTo)
|
||||||
(fs1 ^. sendMemo)
|
(fs1 ^. sendMemo)
|
||||||
|
|
|
||||||
|
|
@ -24,7 +24,7 @@ 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, hexBytes, hexString, toBytes, toText)
|
import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int32, Int64)
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe (fromJust, fromMaybe)
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
import Data.Scientific (Scientific, scientific, toBoundedInteger)
|
import Data.Scientific (Scientific, scientific, toBoundedInteger)
|
||||||
|
|
@ -50,6 +50,7 @@ import ZcashHaskell.Orchard
|
||||||
, genOrchardSpendingKey
|
, genOrchardSpendingKey
|
||||||
, getOrchardFrontier
|
, getOrchardFrontier
|
||||||
, getOrchardNotePosition
|
, getOrchardNotePosition
|
||||||
|
, getOrchardTreeParts
|
||||||
, getOrchardWitness
|
, getOrchardWitness
|
||||||
, isValidUnifiedAddress
|
, isValidUnifiedAddress
|
||||||
, updateOrchardCommitmentTree
|
, updateOrchardCommitmentTree
|
||||||
|
|
@ -62,6 +63,7 @@ import ZcashHaskell.Sapling
|
||||||
, genSaplingSpendingKey
|
, genSaplingSpendingKey
|
||||||
, getSaplingFrontier
|
, getSaplingFrontier
|
||||||
, getSaplingNotePosition
|
, getSaplingNotePosition
|
||||||
|
, getSaplingTreeParts
|
||||||
, getSaplingWitness
|
, getSaplingWitness
|
||||||
, updateSaplingCommitmentTree
|
, updateSaplingCommitmentTree
|
||||||
, updateSaplingWitness
|
, updateSaplingWitness
|
||||||
|
|
@ -74,6 +76,7 @@ import ZcashHaskell.Transparent
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils
|
import ZcashHaskell.Utils
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
|
import Zenith.Tree
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
|
|
@ -303,85 +306,61 @@ 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 pool zebraHost zebraPort znet (b - 1)
|
sT <- liftIO $ getSaplingTree pool
|
||||||
logDebugN "getting Sapling frontier"
|
|
||||||
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
|
|
||||||
case sT of
|
case sT of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
liftIO $ throwIO $ userError "Failed to read Sapling commitment tree"
|
liftIO $ throwIO $ userError "Failed to read Sapling commitment tree"
|
||||||
Just sT' -> do
|
Just (sT', treeSync) -> do
|
||||||
logDebugN "Sapling frontier valid"
|
logDebugN "Sapling tree valid"
|
||||||
decryptNotes sT' zn pool tList
|
mapM_ (decryptNotes sT' zn pool) tList
|
||||||
sapNotes <- liftIO $ getWalletSapNotes pool (entityKey za)
|
sapNotes <- liftIO $ getWalletSapNotes pool (entityKey za)
|
||||||
liftIO $ findSapSpends pool (entityKey za) sapNotes
|
liftIO $ findSapSpends pool (entityKey za) sapNotes
|
||||||
where
|
where
|
||||||
sk :: SaplingSpendingKeyDB
|
sk :: SaplingSpendingKeyDB
|
||||||
sk = zcashAccountSapSpendKey $ entityVal za
|
sk = zcashAccountSapSpendKey $ entityVal za
|
||||||
decryptNotes ::
|
decryptNotes ::
|
||||||
SaplingFrontier
|
Tree SaplingNode
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ConnectionPool
|
-> ConnectionPool
|
||||||
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
-> (Entity ZcashTransaction, Entity ShieldOutput)
|
||||||
-> NoLoggingT IO ()
|
-> NoLoggingT IO ()
|
||||||
decryptNotes _ _ _ [] = return ()
|
decryptNotes st n pool (zt, o) = do
|
||||||
decryptNotes st n pool ((zt, o):txs) = do
|
case getNotePosition st $ fromSqlKey $ entityKey o of
|
||||||
let updatedTree =
|
Nothing -> do
|
||||||
updateSaplingCommitmentTree
|
logErrorN "Couldn't find sapling note in commitment tree"
|
||||||
st
|
return ()
|
||||||
(getHex $ shieldOutputCmu $ entityVal o)
|
Just nP -> do
|
||||||
logDebugN "updated frontier"
|
|
||||||
case updatedTree of
|
|
||||||
Nothing ->
|
|
||||||
liftIO $ throwIO $ userError "Failed to update commitment tree"
|
|
||||||
Just uT -> do
|
|
||||||
let noteWitness = getSaplingWitness uT
|
|
||||||
logDebugN "got witness"
|
|
||||||
let notePos = getSaplingNotePosition <$> noteWitness
|
|
||||||
logDebugN "got position"
|
logDebugN "got position"
|
||||||
case notePos of
|
case decodeShOut External n nP o of
|
||||||
Nothing ->
|
Nothing -> do
|
||||||
liftIO $ throwIO $ userError "Failed to obtain note position"
|
logDebugN "couldn't decode external"
|
||||||
Just nP -> do
|
case decodeShOut Internal n nP o of
|
||||||
case decodeShOut External n nP o of
|
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
logDebugN "couldn't decode external"
|
logDebugN "couldn't decode internal"
|
||||||
case decodeShOut Internal n nP o of
|
Just dn1 -> do
|
||||||
Nothing -> do
|
|
||||||
logDebugN "couldn't decode internal"
|
|
||||||
decryptNotes uT n pool txs
|
|
||||||
Just dn1 -> do
|
|
||||||
wId <-
|
|
||||||
liftIO $ saveWalletTransaction pool (entityKey za) zt
|
|
||||||
liftIO $
|
|
||||||
saveWalletSapNote
|
|
||||||
pool
|
|
||||||
wId
|
|
||||||
nP
|
|
||||||
(fromJust noteWitness)
|
|
||||||
True
|
|
||||||
(entityKey za)
|
|
||||||
(entityKey o)
|
|
||||||
dn1
|
|
||||||
decryptNotes uT n pool txs
|
|
||||||
Just dn0 -> do
|
|
||||||
wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
|
wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
|
||||||
liftIO $
|
liftIO $
|
||||||
saveWalletSapNote
|
saveWalletSapNote
|
||||||
pool
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
True
|
||||||
False
|
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn0
|
dn1
|
||||||
decryptNotes uT n pool txs
|
Just dn0 -> do
|
||||||
|
wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
|
||||||
|
liftIO $
|
||||||
|
saveWalletSapNote
|
||||||
|
pool
|
||||||
|
wId
|
||||||
|
nP
|
||||||
|
False
|
||||||
|
(entityKey za)
|
||||||
|
(entityKey o)
|
||||||
|
dn0
|
||||||
decodeShOut ::
|
decodeShOut ::
|
||||||
Scope
|
Scope -> ZcashNet -> Int32 -> Entity ShieldOutput -> Maybe DecodedNote
|
||||||
-> ZcashNet
|
|
||||||
-> Integer
|
|
||||||
-> Entity ShieldOutput
|
|
||||||
-> Maybe DecodedNote
|
|
||||||
decodeShOut scope n pos s = do
|
decodeShOut scope n pos s = do
|
||||||
decodeSaplingOutputEsk
|
decodeSaplingOutputEsk
|
||||||
(getSapSK sk)
|
(getSapSK sk)
|
||||||
|
|
@ -394,7 +373,7 @@ findSaplingOutputs config b znet za = do
|
||||||
(getHex $ shieldOutputProof $ entityVal s))
|
(getHex $ shieldOutputProof $ entityVal s))
|
||||||
n
|
n
|
||||||
scope
|
scope
|
||||||
pos
|
(fromIntegral pos)
|
||||||
|
|
||||||
-- | Get Orchard actions
|
-- | Get Orchard actions
|
||||||
findOrchardActions ::
|
findOrchardActions ::
|
||||||
|
|
@ -410,67 +389,52 @@ 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 pool zebraHost zebraPort znet (b - 1)
|
sT <- getOrchardTree pool
|
||||||
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"
|
||||||
Just sT' -> do
|
Just (sT', treeSync) -> do
|
||||||
decryptNotes sT' zn pool tList
|
mapM_ (decryptNotes sT' zn pool) tList
|
||||||
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
||||||
findOrchSpends pool (entityKey za) orchNotes
|
findOrchSpends pool (entityKey za) orchNotes
|
||||||
where
|
where
|
||||||
decryptNotes ::
|
decryptNotes ::
|
||||||
OrchardFrontier
|
Tree OrchardNode
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ConnectionPool
|
-> ConnectionPool
|
||||||
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
-> (Entity ZcashTransaction, Entity OrchAction)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
decryptNotes _ _ _ [] = return ()
|
decryptNotes ot n pool (zt, o) = do
|
||||||
decryptNotes ot n pool ((zt, o):txs) = do
|
case getNotePosition ot (fromSqlKey $ entityKey o) of
|
||||||
let updatedTree =
|
Nothing -> do
|
||||||
updateOrchardCommitmentTree
|
return ()
|
||||||
ot
|
Just nP ->
|
||||||
(getHex $ orchActionCmx $ entityVal o)
|
case decodeOrchAction External nP o of
|
||||||
case updatedTree of
|
Nothing ->
|
||||||
Nothing -> throwIO $ userError "Failed to update commitment tree"
|
case decodeOrchAction Internal nP o of
|
||||||
Just uT -> do
|
Nothing -> return ()
|
||||||
let noteWitness = getOrchardWitness uT
|
Just dn1 -> do
|
||||||
let notePos = getOrchardNotePosition <$> noteWitness
|
|
||||||
case notePos of
|
|
||||||
Nothing -> throwIO $ userError "Failed to obtain note position"
|
|
||||||
Just nP ->
|
|
||||||
case decodeOrchAction External nP o of
|
|
||||||
Nothing ->
|
|
||||||
case decodeOrchAction Internal nP o of
|
|
||||||
Nothing -> decryptNotes uT n pool txs
|
|
||||||
Just dn1 -> do
|
|
||||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
|
||||||
saveWalletOrchNote
|
|
||||||
pool
|
|
||||||
wId
|
|
||||||
nP
|
|
||||||
(fromJust noteWitness)
|
|
||||||
True
|
|
||||||
(entityKey za)
|
|
||||||
(entityKey o)
|
|
||||||
dn1
|
|
||||||
decryptNotes uT n pool txs
|
|
||||||
Just dn -> do
|
|
||||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
saveWalletOrchNote
|
saveWalletOrchNote
|
||||||
pool
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
True
|
||||||
False
|
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn
|
dn1
|
||||||
decryptNotes uT n pool txs
|
Just dn -> do
|
||||||
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
|
saveWalletOrchNote
|
||||||
|
pool
|
||||||
|
wId
|
||||||
|
nP
|
||||||
|
False
|
||||||
|
(entityKey za)
|
||||||
|
(entityKey o)
|
||||||
|
dn
|
||||||
sk :: OrchardSpendingKeyDB
|
sk :: OrchardSpendingKeyDB
|
||||||
sk = zcashAccountOrchSpendKey $ entityVal za
|
sk = zcashAccountOrchSpendKey $ entityVal za
|
||||||
decodeOrchAction ::
|
decodeOrchAction :: Scope -> Int32 -> Entity OrchAction -> Maybe DecodedNote
|
||||||
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
|
|
||||||
decodeOrchAction scope pos o =
|
decodeOrchAction scope pos o =
|
||||||
decryptOrchardActionSK (getOrchSK sk) scope $
|
decryptOrchardActionSK (getOrchSK sk) scope $
|
||||||
OrchardAction
|
OrchardAction
|
||||||
|
|
@ -814,11 +778,6 @@ shieldTransparentNotes ::
|
||||||
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
accRead <- liftIO $ getAccountById pool za
|
accRead <- liftIO $ getAccountById pool za
|
||||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
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
|
case accRead of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
logErrorN "Can't find Account"
|
logErrorN "Can't find Account"
|
||||||
|
|
@ -831,6 +790,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
(\x ->
|
(\x ->
|
||||||
filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes')
|
filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes')
|
||||||
dRecvs
|
dRecvs
|
||||||
|
sTree <- liftIO $ getSaplingTree pool
|
||||||
|
oTree <- liftIO $ getOrchardTree pool
|
||||||
forM fNotes $ \trNotes -> do
|
forM fNotes $ \trNotes -> do
|
||||||
let noteTotal = getTotalAmount (trNotes, [], [])
|
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||||
tSpends <-
|
tSpends <-
|
||||||
|
|
@ -864,8 +825,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
tx <-
|
tx <-
|
||||||
liftIO $
|
liftIO $
|
||||||
createTransaction
|
createTransaction
|
||||||
Nothing
|
(maybe (hexString "00") (getHash . value . fst) sTree)
|
||||||
Nothing
|
(maybe (hexString "00") (getHash . value . fst) oTree)
|
||||||
tSpends
|
tSpends
|
||||||
[]
|
[]
|
||||||
[]
|
[]
|
||||||
|
|
@ -931,10 +892,8 @@ 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 <-
|
sTree <- liftIO $ getSaplingTree pool
|
||||||
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
|
oTree <- liftIO $ getOrchardTree pool
|
||||||
let sT = SaplingCommitmentTree $ ztiSapling 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"
|
||||||
|
|
@ -969,24 +928,6 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
logDebugN $ T.pack $ show oList
|
logDebugN $ T.pack $ show oList
|
||||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||||
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
|
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
|
||||||
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
|
|
||||||
draft <-
|
draft <-
|
||||||
liftIO $
|
liftIO $
|
||||||
makeOutgoing
|
makeOutgoing
|
||||||
|
|
@ -1022,11 +963,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
liftIO $
|
liftIO $
|
||||||
prepSSpends
|
prepSSpends
|
||||||
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||||
|
(maybe InvalidTree fst sTree)
|
||||||
sList1
|
sList1
|
||||||
oSpends1 <-
|
oSpends1 <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepOSpends
|
prepOSpends
|
||||||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
|
(maybe InvalidTree fst oTree)
|
||||||
oList1
|
oList1
|
||||||
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
|
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
|
||||||
outgoing' <-
|
outgoing' <-
|
||||||
|
|
@ -1043,8 +986,14 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
tx <-
|
tx <-
|
||||||
liftIO $
|
liftIO $
|
||||||
createTransaction
|
createTransaction
|
||||||
(Just sT)
|
(maybe
|
||||||
(Just oT)
|
(hexString "00")
|
||||||
|
(getHash . value . fst)
|
||||||
|
sTree)
|
||||||
|
(maybe
|
||||||
|
(hexString "00")
|
||||||
|
(getHash . value . fst)
|
||||||
|
oTree)
|
||||||
tSpends1
|
tSpends1
|
||||||
sSpends1
|
sSpends1
|
||||||
oSpends1
|
oSpends1
|
||||||
|
|
@ -1300,9 +1249,16 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||||
(walletTrNoteScript $ entityVal n))
|
(walletTrNoteScript $ entityVal n))
|
||||||
prepSSpends ::
|
prepSSpends ::
|
||||||
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
SaplingSpendingKey
|
||||||
prepSSpends sk notes = do
|
-> Tree SaplingNode
|
||||||
|
-> [Entity WalletSapNote]
|
||||||
|
-> IO [SaplingTxSpend]
|
||||||
|
prepSSpends sk tree notes = do
|
||||||
forM notes $ \n -> do
|
forM notes $ \n -> do
|
||||||
|
let notePath =
|
||||||
|
Zenith.Tree.path
|
||||||
|
(fromIntegral $ walletSapNotePosition $ entityVal n)
|
||||||
|
tree
|
||||||
return $
|
return $
|
||||||
SaplingTxSpend
|
SaplingTxSpend
|
||||||
(getBytes sk)
|
(getBytes sk)
|
||||||
|
|
@ -1313,11 +1269,18 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
(getHex $ walletSapNoteNullifier $ entityVal n)
|
(getHex $ walletSapNoteNullifier $ entityVal n)
|
||||||
""
|
""
|
||||||
(getRseed $ walletSapNoteRseed $ entityVal n))
|
(getRseed $ walletSapNoteRseed $ entityVal n))
|
||||||
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
(fromMaybe nullPath notePath)
|
||||||
prepOSpends ::
|
prepOSpends ::
|
||||||
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
OrchardSpendingKey
|
||||||
prepOSpends sk notes = do
|
-> Tree OrchardNode
|
||||||
|
-> [Entity WalletOrchNote]
|
||||||
|
-> IO [OrchardTxSpend]
|
||||||
|
prepOSpends sk tree notes = do
|
||||||
forM notes $ \n -> do
|
forM notes $ \n -> do
|
||||||
|
let notePath =
|
||||||
|
Zenith.Tree.path
|
||||||
|
(fromIntegral $ walletOrchNotePosition $ entityVal n)
|
||||||
|
tree
|
||||||
return $
|
return $
|
||||||
OrchardTxSpend
|
OrchardTxSpend
|
||||||
(getBytes sk)
|
(getBytes sk)
|
||||||
|
|
@ -1328,21 +1291,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
(getHex $ walletOrchNoteNullifier $ entityVal n)
|
(getHex $ walletOrchNoteNullifier $ entityVal n)
|
||||||
(walletOrchNoteRho $ entityVal n)
|
(walletOrchNoteRho $ entityVal n)
|
||||||
(getRseed $ walletOrchNoteRseed $ entityVal n))
|
(getRseed $ walletOrchNoteRseed $ entityVal n))
|
||||||
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
(fromMaybe nullPath notePath)
|
||||||
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
|
|
||||||
|
|
||||||
-- | Sync the wallet with the data store
|
-- | Sync the wallet with the data store
|
||||||
syncWallet ::
|
syncWallet ::
|
||||||
|
|
@ -1388,10 +1337,95 @@ syncWallet config w = do
|
||||||
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
||||||
accs
|
accs
|
||||||
logDebugN "processed orchard actions"
|
logDebugN "processed orchard actions"
|
||||||
_ <- liftIO $ updateSaplingWitnesses pool
|
|
||||||
logDebugN "updated sapling witnesses"
|
|
||||||
_ <- liftIO $ updateOrchardWitnesses pool
|
|
||||||
logDebugN "updated orchard witnesses"
|
|
||||||
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
||||||
logDebugN "updated wallet lastSync"
|
logDebugN "updated wallet lastSync"
|
||||||
mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs
|
mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs
|
||||||
|
|
||||||
|
-- | Update commitment trees
|
||||||
|
updateCommitmentTrees ::
|
||||||
|
ConnectionPool -> T.Text -> Int -> ZcashNetDB -> LoggingT IO ()
|
||||||
|
updateCommitmentTrees pool zHost zPort zNet = do
|
||||||
|
sTdb <- liftIO $ getSaplingTree pool
|
||||||
|
oTdb <- liftIO $ getOrchardTree pool
|
||||||
|
maxBlock <- liftIO $ getMaxBlock pool zNet
|
||||||
|
newSapTree <-
|
||||||
|
case sTdb of
|
||||||
|
Nothing -> do
|
||||||
|
logDebugN ">no Sapling tree in DB"
|
||||||
|
bh <- liftIO $ getMinBirthdayHeight pool zNet
|
||||||
|
logDebugN $ ">min birthday: " <> T.pack (show bh)
|
||||||
|
saplingNotes <- liftIO $ getShieldedOutputs pool (bh + 1) zNet
|
||||||
|
let saplingComm =
|
||||||
|
map
|
||||||
|
(\(_, y) ->
|
||||||
|
( getHex $ shieldOutputCmu (entityVal y)
|
||||||
|
, fromSqlKey (entityKey y)))
|
||||||
|
saplingNotes
|
||||||
|
logDebugN ">got shielded outputs"
|
||||||
|
treeInfo <- liftIO $ getCommitmentTrees pool zHost zPort zNet bh
|
||||||
|
case getSaplingTreeParts (SaplingCommitmentTree $ ztiSapling treeInfo) of
|
||||||
|
Nothing -> do
|
||||||
|
logDebugN ">failed to load tree from Zebra"
|
||||||
|
return InvalidTree
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkSaplingTree t1
|
||||||
|
return $ foldl' append newTree saplingComm
|
||||||
|
Just (sTree, sSync) -> do
|
||||||
|
logDebugN $ ">Sapling tree found, synced to " <> T.pack (show sSync)
|
||||||
|
saplingNotes <- liftIO $ getShieldedOutputs pool (sSync + 1) zNet
|
||||||
|
let saplingComm =
|
||||||
|
map
|
||||||
|
(\(_, y) ->
|
||||||
|
( getHex $ shieldOutputCmu (entityVal y)
|
||||||
|
, fromSqlKey (entityKey y)))
|
||||||
|
saplingNotes
|
||||||
|
logDebugN ">got shielded outputs"
|
||||||
|
return $ foldl' append sTree saplingComm
|
||||||
|
newOrchTree <-
|
||||||
|
case oTdb of
|
||||||
|
Nothing -> do
|
||||||
|
logDebugN ">no Orchard tree in DB"
|
||||||
|
bh <- liftIO $ getMinBirthdayHeight pool zNet
|
||||||
|
logDebugN $ ">min birthday: " <> T.pack (show bh)
|
||||||
|
orchardNotes <- liftIO $ getOrchardActions pool (bh + 1) zNet
|
||||||
|
let orchardComm =
|
||||||
|
map
|
||||||
|
(\(_, y) ->
|
||||||
|
( getHex $ orchActionCmx (entityVal y)
|
||||||
|
, fromSqlKey (entityKey y)))
|
||||||
|
orchardNotes
|
||||||
|
logDebugN ">got orchard actions"
|
||||||
|
treeInfo <- liftIO $ getCommitmentTrees pool zHost zPort zNet bh
|
||||||
|
case getOrchardTreeParts (OrchardCommitmentTree $ ztiOrchard treeInfo) of
|
||||||
|
Nothing -> do
|
||||||
|
logDebugN ">failed to load tree from Zebra"
|
||||||
|
return InvalidTree
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
return $ foldl' append newTree orchardComm
|
||||||
|
Just (oTree, oSync) -> do
|
||||||
|
logDebugN $ ">Orchard tree found, synced to " <> T.pack (show oSync)
|
||||||
|
orchardNotes <- liftIO $ getOrchardActions pool (oSync + 1) zNet
|
||||||
|
let orchardComm =
|
||||||
|
map
|
||||||
|
(\(_, y) ->
|
||||||
|
( getHex $ orchActionCmx (entityVal y)
|
||||||
|
, fromSqlKey (entityKey y)))
|
||||||
|
orchardNotes
|
||||||
|
logDebugN ">got orchard actions"
|
||||||
|
return $ foldl' append oTree orchardComm
|
||||||
|
case newSapTree of
|
||||||
|
Branch {} -> do
|
||||||
|
logInfoN ">Saving updated Sapling tree to db"
|
||||||
|
_ <- liftIO $ upsertSaplingTree pool maxBlock newSapTree
|
||||||
|
case newOrchTree of
|
||||||
|
Branch {} -> do
|
||||||
|
logInfoN ">Saving updated Orchard tree to db"
|
||||||
|
_ <- liftIO $ upsertOrchardTree pool maxBlock newOrchTree
|
||||||
|
return ()
|
||||||
|
_anyOther -> do
|
||||||
|
logErrorN ">Failed to update the Orchard tree"
|
||||||
|
return ()
|
||||||
|
_anyOther -> do
|
||||||
|
logErrorN ">Failed to update the Sapling tree"
|
||||||
|
return ()
|
||||||
|
|
|
||||||
206
src/Zenith/DB.hs
206
src/Zenith/DB.hs
|
|
@ -18,6 +18,7 @@
|
||||||
|
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
|
import Codec.Borsh
|
||||||
import Control.Exception (SomeException(..), throw, throwIO, try)
|
import Control.Exception (SomeException(..), throw, throwIO, try)
|
||||||
import Control.Monad (unless, when)
|
import Control.Monad (unless, when)
|
||||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||||
|
|
@ -25,6 +26,7 @@ import Control.Monad.Logger
|
||||||
( LoggingT
|
( LoggingT
|
||||||
, NoLoggingT
|
, NoLoggingT
|
||||||
, logDebugN
|
, logDebugN
|
||||||
|
, logErrorN
|
||||||
, runNoLoggingT
|
, runNoLoggingT
|
||||||
, runStderrLoggingT
|
, runStderrLoggingT
|
||||||
)
|
)
|
||||||
|
|
@ -80,6 +82,7 @@ import ZcashHaskell.Types
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
|
import Zenith.Tree (OrchardNode(..), SaplingNode(..), Tree(..), truncateTree)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AccountBalance(..)
|
( AccountBalance(..)
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
|
|
@ -304,6 +307,12 @@ share
|
||||||
status ZenithStatus
|
status ZenithStatus
|
||||||
UniqueSync name
|
UniqueSync name
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|
TreeStore
|
||||||
|
pool ZcashPool
|
||||||
|
bytes BS.ByteString
|
||||||
|
lastSync Int
|
||||||
|
UniquePool pool
|
||||||
|
deriving Show Eq
|
||||||
|]
|
|]
|
||||||
|
|
||||||
-- ** Type conversions
|
-- ** Type conversions
|
||||||
|
|
@ -919,15 +928,17 @@ getMaxWalletBlock pool = do
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ walletTransactionBlock $ entityVal x
|
Just x -> return $ walletTransactionBlock $ entityVal x
|
||||||
|
|
||||||
getMinBirthdayHeight :: ConnectionPool -> IO Int
|
getMinBirthdayHeight :: ConnectionPool -> ZcashNetDB -> IO Int
|
||||||
getMinBirthdayHeight pool = do
|
getMinBirthdayHeight pool znet = do
|
||||||
b <-
|
b <-
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
w <- from $ table @ZcashWallet
|
w <- from $ table @ZcashWallet
|
||||||
where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
|
where_
|
||||||
|
(w ^. ZcashWalletBirthdayHeight >. val 0 &&. w ^. ZcashWalletNetwork ==.
|
||||||
|
val znet)
|
||||||
orderBy [asc $ w ^. ZcashWalletBirthdayHeight]
|
orderBy [asc $ w ^. ZcashWalletBirthdayHeight]
|
||||||
pure w
|
pure w
|
||||||
case b of
|
case b of
|
||||||
|
|
@ -983,14 +994,13 @@ saveWalletTransaction pool za zt = do
|
||||||
saveWalletSapNote ::
|
saveWalletSapNote ::
|
||||||
ConnectionPool -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
||||||
-> Integer -- ^ note position
|
-> Int32 -- ^ note position
|
||||||
-> SaplingWitness -- ^ the Sapling incremental witness
|
|
||||||
-> Bool -- ^ change flag
|
-> Bool -- ^ change flag
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> ShieldOutputId
|
-> ShieldOutputId
|
||||||
-> DecodedNote -- The decoded Sapling note
|
-> DecodedNote -- The decoded Sapling note
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletSapNote pool wId pos wit ch za zt dn = do
|
saveWalletSapNote pool wId pos ch za zt dn = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
|
@ -1005,7 +1015,7 @@ saveWalletSapNote pool wId pos wit ch za zt dn = do
|
||||||
False
|
False
|
||||||
(HexStringDB $ a_nullifier dn)
|
(HexStringDB $ a_nullifier dn)
|
||||||
(fromIntegral pos)
|
(fromIntegral pos)
|
||||||
(HexStringDB $ sapWit wit)
|
(HexStringDB $ hexString "00")
|
||||||
ch
|
ch
|
||||||
zt
|
zt
|
||||||
(RseedDB $ a_rseed dn))
|
(RseedDB $ a_rseed dn))
|
||||||
|
|
@ -1016,14 +1026,13 @@ saveWalletSapNote pool wId pos wit ch za zt dn = do
|
||||||
saveWalletOrchNote ::
|
saveWalletOrchNote ::
|
||||||
ConnectionPool
|
ConnectionPool
|
||||||
-> WalletTransactionId
|
-> WalletTransactionId
|
||||||
-> Integer
|
-> Int32
|
||||||
-> OrchardWitness
|
|
||||||
-> Bool
|
-> Bool
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> OrchActionId
|
-> OrchActionId
|
||||||
-> DecodedNote
|
-> DecodedNote
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletOrchNote pool wId pos wit ch za zt dn = do
|
saveWalletOrchNote pool wId pos ch za zt dn = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
|
@ -1038,7 +1047,7 @@ saveWalletOrchNote pool wId pos wit ch za zt dn = do
|
||||||
False
|
False
|
||||||
(HexStringDB $ a_nullifier dn)
|
(HexStringDB $ a_nullifier dn)
|
||||||
(fromIntegral pos)
|
(fromIntegral pos)
|
||||||
(HexStringDB $ orchWit wit)
|
(HexStringDB $ hexString "00")
|
||||||
ch
|
ch
|
||||||
zt
|
zt
|
||||||
(a_rho dn)
|
(a_rho dn)
|
||||||
|
|
@ -2159,6 +2168,9 @@ clearWalletData pool = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
delete $ do
|
||||||
|
_ <- from $ table @TreeStore
|
||||||
|
return ()
|
||||||
delete $ do
|
delete $ do
|
||||||
_ <- from $ table @TransparentNote
|
_ <- from $ table @TransparentNote
|
||||||
return ()
|
return ()
|
||||||
|
|
@ -2812,7 +2824,173 @@ rewindWalletData pool b net = do
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
delete $ do
|
delete $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_
|
where_ $
|
||||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
(blk ^. ZcashBlockHeight >. val b) &&.
|
||||||
val net)
|
(blk ^. ZcashBlockNetwork ==. val net)
|
||||||
logDebugN "Completed data store rewind"
|
logDebugN "Completed data store rewind"
|
||||||
|
saplingOutputIx <- liftIO $ getSaplingOutputAtBlock pool net b
|
||||||
|
orchardActionIx <- liftIO $ getOrchardActionAtBlock pool net b
|
||||||
|
case saplingOutputIx of
|
||||||
|
Nothing -> logErrorN "Couldn't get Sapling output index for tree rewind"
|
||||||
|
Just soIx -> do
|
||||||
|
saplingTree <- liftIO $ getSaplingTree pool
|
||||||
|
let truncSapTree = truncateTree (maybe InvalidTree fst saplingTree) soIx
|
||||||
|
_ <- liftIO $ upsertSaplingTree pool b truncSapTree
|
||||||
|
logDebugN $ "Truncated Sapling tree at index " <> T.pack (show soIx)
|
||||||
|
case orchardActionIx of
|
||||||
|
Nothing -> logErrorN "Couldn't get Orchard action index for tree rewind"
|
||||||
|
Just oaIx -> do
|
||||||
|
orchardTree <- liftIO $ getOrchardTree pool
|
||||||
|
let truncOrchTree =
|
||||||
|
truncateTree (maybe InvalidTree fst orchardTree) oaIx
|
||||||
|
_ <- liftIO $ upsertOrchardTree pool b truncOrchTree
|
||||||
|
logDebugN $ "Truncated Orchard tree at index " <> T.pack (show oaIx)
|
||||||
|
|
||||||
|
getSaplingOutputAtBlock ::
|
||||||
|
ConnectionPool -> ZcashNetDB -> Int -> IO (Maybe Int64)
|
||||||
|
getSaplingOutputAtBlock pool znet b = do
|
||||||
|
r <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
selectOne $ do
|
||||||
|
(blks :& txs :& sOutputs) <-
|
||||||
|
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||||
|
(\(blks :& txs) ->
|
||||||
|
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
||||||
|
table @ShieldOutput `on`
|
||||||
|
(\(_ :& txs :& sOutputs) ->
|
||||||
|
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
||||||
|
where_ (blks ^. ZcashBlockHeight <=. val b)
|
||||||
|
where_ (blks ^. ZcashBlockNetwork ==. val znet)
|
||||||
|
orderBy
|
||||||
|
[ desc $ txs ^. ZcashTransactionId
|
||||||
|
, desc $ sOutputs ^. ShieldOutputPosition
|
||||||
|
]
|
||||||
|
return sOutputs
|
||||||
|
case r of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just so -> return $ Just $ fromSqlKey $ entityKey so
|
||||||
|
|
||||||
|
getOrchardActionAtBlock ::
|
||||||
|
ConnectionPool -> ZcashNetDB -> Int -> IO (Maybe Int64)
|
||||||
|
getOrchardActionAtBlock pool znet b = do
|
||||||
|
r <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
selectOne $ do
|
||||||
|
(blks :& txs :& oActions) <-
|
||||||
|
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||||
|
(\(blks :& txs) ->
|
||||||
|
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
||||||
|
table @OrchAction `on`
|
||||||
|
(\(_ :& txs :& oActions) ->
|
||||||
|
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
||||||
|
where_ (blks ^. ZcashBlockHeight <=. val b)
|
||||||
|
where_ (blks ^. ZcashBlockNetwork ==. val znet)
|
||||||
|
orderBy
|
||||||
|
[ desc $ txs ^. ZcashTransactionId
|
||||||
|
, desc $ oActions ^. OrchActionPosition
|
||||||
|
]
|
||||||
|
return oActions
|
||||||
|
case r of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just so -> return $ Just $ fromSqlKey $ entityKey so
|
||||||
|
|
||||||
|
-- * Tree storage
|
||||||
|
-- | Read the Orchard commitment tree
|
||||||
|
getOrchardTree :: ConnectionPool -> IO (Maybe (Tree OrchardNode, Int))
|
||||||
|
getOrchardTree pool = do
|
||||||
|
treeRecord <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
selectOne $ do
|
||||||
|
tr <- from $ table @TreeStore
|
||||||
|
where_ (tr ^. TreeStorePool ==. val OrchardPool)
|
||||||
|
pure tr
|
||||||
|
case treeRecord of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just tR ->
|
||||||
|
case deserialiseBorsh $ BS.fromStrict $ treeStoreBytes $ entityVal tR of
|
||||||
|
Left _ -> return Nothing
|
||||||
|
Right t -> return $ Just (t, treeStoreLastSync $ entityVal tR)
|
||||||
|
|
||||||
|
-- | Save the Orchard commitment tree
|
||||||
|
upsertOrchardTree :: ConnectionPool -> Int -> Tree OrchardNode -> IO ()
|
||||||
|
upsertOrchardTree pool ls tree = do
|
||||||
|
let treeBytes = BS.toStrict $ serialiseBorsh tree
|
||||||
|
chk <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
select $ do
|
||||||
|
tr <- from $ table @TreeStore
|
||||||
|
where_ (tr ^. TreeStorePool ==. val OrchardPool)
|
||||||
|
pure tr
|
||||||
|
if not (null chk)
|
||||||
|
then do
|
||||||
|
_ <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
update $ \p -> do
|
||||||
|
set p [TreeStoreBytes =. val treeBytes, TreeStoreLastSync =. val ls]
|
||||||
|
where_ $ p ^. TreeStorePool ==. val OrchardPool
|
||||||
|
return ()
|
||||||
|
else do
|
||||||
|
_ <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $
|
||||||
|
insertUnique_ $ TreeStore OrchardPool treeBytes ls
|
||||||
|
return ()
|
||||||
|
|
||||||
|
-- | Read the Sapling commitment tree
|
||||||
|
getSaplingTree :: ConnectionPool -> IO (Maybe (Tree SaplingNode, Int))
|
||||||
|
getSaplingTree pool = do
|
||||||
|
treeRecord <-
|
||||||
|
runStderrLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
selectOne $ do
|
||||||
|
tr <- from $ table @TreeStore
|
||||||
|
where_ (tr ^. TreeStorePool ==. val SaplingPool)
|
||||||
|
pure tr
|
||||||
|
case treeRecord of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just tR ->
|
||||||
|
case deserialiseBorsh $ BS.fromStrict $ treeStoreBytes $ entityVal tR of
|
||||||
|
Left _ -> return Nothing
|
||||||
|
Right t -> return $ Just (t, treeStoreLastSync $ entityVal tR)
|
||||||
|
|
||||||
|
-- | Save the Sapling commitment tree
|
||||||
|
upsertSaplingTree :: ConnectionPool -> Int -> Tree SaplingNode -> IO ()
|
||||||
|
upsertSaplingTree pool ls tree = do
|
||||||
|
let treeBytes = BS.toStrict $ serialiseBorsh tree
|
||||||
|
chk <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
select $ do
|
||||||
|
tr <- from $ table @TreeStore
|
||||||
|
where_ (tr ^. TreeStorePool ==. val SaplingPool)
|
||||||
|
pure tr
|
||||||
|
if not (null chk)
|
||||||
|
then do
|
||||||
|
_ <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
update $ \p -> do
|
||||||
|
set p [TreeStoreBytes =. val treeBytes, TreeStoreLastSync =. val ls]
|
||||||
|
where_ $ p ^. TreeStorePool ==. val SaplingPool
|
||||||
|
return ()
|
||||||
|
else do
|
||||||
|
_ <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $
|
||||||
|
insertUnique_ $ TreeStore SaplingPool treeBytes ls
|
||||||
|
return ()
|
||||||
|
|
|
||||||
|
|
@ -1625,7 +1625,7 @@ scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||||
scanZebra dbPath zHost zPort net sendMsg = do
|
scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
b <- liftIO $ getMinBirthdayHeight pool
|
b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net
|
||||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||||
syncChk <- isSyncing pool
|
syncChk <- isSyncing pool
|
||||||
|
|
|
||||||
|
|
@ -887,7 +887,7 @@ scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
|
||||||
scanZebra dbPath zHost zPort net = do
|
scanZebra dbPath zHost zPort net = do
|
||||||
bStatus <- checkBlockChain zHost zPort
|
bStatus <- checkBlockChain zHost zPort
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
b <- getMinBirthdayHeight pool
|
b <- getMinBirthdayHeight pool $ ZcashNetDB net
|
||||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||||
syncChk <- isSyncing pool
|
syncChk <- isSyncing pool
|
||||||
|
|
|
||||||
|
|
@ -31,7 +31,7 @@ import ZcashHaskell.Types
|
||||||
, fromRawTBundle
|
, fromRawTBundle
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||||
import Zenith.Core (checkBlockChain, syncWallet)
|
import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
( ZcashBlock(..)
|
( ZcashBlock(..)
|
||||||
, ZcashBlockId
|
, ZcashBlockId
|
||||||
|
|
@ -83,7 +83,7 @@ rescanZebra host port dbFilePath = do
|
||||||
clearWalletData pool1
|
clearWalletData pool1
|
||||||
_ <- startSync pool1
|
_ <- startSync pool1
|
||||||
dbBlock <- getMaxBlock pool1 znet
|
dbBlock <- getMaxBlock pool1 znet
|
||||||
b <- liftIO $ getMinBirthdayHeight pool1
|
b <- liftIO $ getMinBirthdayHeight pool1 znet
|
||||||
let sb = max dbBlock b
|
let sb = max dbBlock b
|
||||||
if sb > zgb_blocks bStatus || sb < 1
|
if sb > zgb_blocks bStatus || sb < 1
|
||||||
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
||||||
|
|
@ -108,6 +108,7 @@ rescanZebra host port dbFilePath = do
|
||||||
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
|
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
|
||||||
print "Please wait..."
|
print "Please wait..."
|
||||||
_ <- completeSync pool1 Successful
|
_ <- completeSync pool1 Successful
|
||||||
|
_ <- runStderrLoggingT $ updateCommitmentTrees pool1 host port znet
|
||||||
print "Rescan complete"
|
print "Rescan complete"
|
||||||
|
|
||||||
-- | Function to process a raw block and extract the transaction information
|
-- | Function to process a raw block and extract the transaction information
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,13 @@ import Data.Maybe (fromJust, isNothing)
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
import qualified Generics.SOP as SOP
|
import qualified Generics.SOP as SOP
|
||||||
import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
|
import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
|
||||||
import ZcashHaskell.Types (MerklePath(..), OrchardFrontier(..), OrchardTree(..))
|
import ZcashHaskell.Sapling (combineSaplingNodes, getSaplingNodeValue)
|
||||||
|
import ZcashHaskell.Types
|
||||||
|
( MerklePath(..)
|
||||||
|
, OrchardFrontier(..)
|
||||||
|
, OrchardTree(..)
|
||||||
|
, SaplingTree(..)
|
||||||
|
)
|
||||||
|
|
||||||
type Level = Int8
|
type Level = Int8
|
||||||
|
|
||||||
|
|
@ -33,6 +39,7 @@ class Node v where
|
||||||
getLevel :: v -> Level
|
getLevel :: v -> Level
|
||||||
getHash :: v -> HexString
|
getHash :: v -> HexString
|
||||||
getPosition :: v -> Position
|
getPosition :: v -> Position
|
||||||
|
getIndex :: v -> Int64
|
||||||
isFull :: v -> Bool
|
isFull :: v -> Bool
|
||||||
isMarked :: v -> Bool
|
isMarked :: v -> Bool
|
||||||
mkNode :: Level -> Position -> HexString -> v
|
mkNode :: Level -> Position -> HexString -> v
|
||||||
|
|
@ -45,6 +52,14 @@ instance Measured OrchardCommitment OrchardNode where
|
||||||
Nothing -> OrchardNode 0 (hexString "00") 0 True 0 False
|
Nothing -> OrchardNode 0 (hexString "00") 0 True 0 False
|
||||||
Just val -> OrchardNode p val 0 True i False
|
Just val -> OrchardNode p val 0 True i False
|
||||||
|
|
||||||
|
type SaplingCommitment = HexString
|
||||||
|
|
||||||
|
instance Measured SaplingCommitment SaplingNode where
|
||||||
|
measure sc p i =
|
||||||
|
case getSaplingNodeValue (hexBytes sc) of
|
||||||
|
Nothing -> SaplingNode 0 (hexString "00") 0 True 0 False
|
||||||
|
Just val -> SaplingNode p val 0 True i False
|
||||||
|
|
||||||
data Tree v
|
data Tree v
|
||||||
= EmptyLeaf
|
= EmptyLeaf
|
||||||
| Leaf !v
|
| Leaf !v
|
||||||
|
|
@ -88,7 +103,7 @@ instance (Monoid v, Node v) => Semigroup (Tree v) where
|
||||||
| getLevel s == getLevel w = branch (Branch s x y) (PrunedBranch w)
|
| getLevel s == getLevel w = branch (Branch s x y) (PrunedBranch w)
|
||||||
| otherwise = InvalidTree
|
| otherwise = InvalidTree
|
||||||
(<>) (Branch s x y) (Leaf w)
|
(<>) (Branch s x y) (Leaf w)
|
||||||
| isFull s = Branch s x y <> mkSubTree (getLevel s) (Leaf w)
|
| isFull s = InvalidTree
|
||||||
| isFull (value x) = branch x (y <> Leaf w)
|
| isFull (value x) = branch x (y <> Leaf w)
|
||||||
| otherwise = branch (x <> Leaf w) y
|
| otherwise = branch (x <> Leaf w) y
|
||||||
(<>) (Branch s x y) (Branch s1 x1 y1)
|
(<>) (Branch s x y) (Branch s1 x1 y1)
|
||||||
|
|
@ -151,6 +166,101 @@ path pos (Branch s x y) =
|
||||||
| otherwise = []
|
| otherwise = []
|
||||||
path _ _ = Nothing
|
path _ _ = Nothing
|
||||||
|
|
||||||
|
nullPath :: MerklePath
|
||||||
|
nullPath = MerklePath 0 []
|
||||||
|
|
||||||
|
getNotePosition :: Monoid v => Node v => Tree v -> Int64 -> Maybe Position
|
||||||
|
getNotePosition (Leaf x) i
|
||||||
|
| getIndex x == i = Just $ getPosition x
|
||||||
|
| otherwise = Nothing
|
||||||
|
getNotePosition (Branch _ x y) i
|
||||||
|
| getIndex (value x) >= i = getNotePosition x i
|
||||||
|
| getIndex (value y) >= i = getNotePosition y i
|
||||||
|
| otherwise = Nothing
|
||||||
|
getNotePosition _ _ = Nothing
|
||||||
|
|
||||||
|
truncateTree :: Monoid v => Node v => Tree v -> Int64 -> Tree v
|
||||||
|
truncateTree (Branch s x y) i
|
||||||
|
| getLevel s == 1 && getIndex (value x) == i = branch x EmptyLeaf
|
||||||
|
| getLevel s == 1 && getIndex (value y) == i = branch x y
|
||||||
|
| getIndex (value x) >= i =
|
||||||
|
branch (truncateTree x i) (getEmptyRoot (getLevel s))
|
||||||
|
| getIndex (value y) >= i = branch x (truncateTree y i)
|
||||||
|
truncateTree x _ = x
|
||||||
|
|
||||||
|
data SaplingNode = SaplingNode
|
||||||
|
{ sn_position :: !Position
|
||||||
|
, sn_value :: !HexString
|
||||||
|
, sn_level :: !Level
|
||||||
|
, sn_full :: !Bool
|
||||||
|
, sn_index :: !Int64
|
||||||
|
, sn_mark :: !Bool
|
||||||
|
} deriving stock (Eq, GHC.Generic)
|
||||||
|
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||||
|
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct SaplingNode
|
||||||
|
|
||||||
|
instance Semigroup SaplingNode where
|
||||||
|
(<>) x y =
|
||||||
|
case combineSaplingNodes (sn_level x) (sn_value x) (sn_value y) of
|
||||||
|
Nothing -> x
|
||||||
|
Just newHash ->
|
||||||
|
SaplingNode
|
||||||
|
(max (sn_position x) (sn_position y))
|
||||||
|
newHash
|
||||||
|
(1 + sn_level x)
|
||||||
|
(sn_full x && sn_full y)
|
||||||
|
(max (sn_index x) (sn_index y))
|
||||||
|
(sn_mark x || sn_mark y)
|
||||||
|
|
||||||
|
instance Monoid SaplingNode where
|
||||||
|
mempty = SaplingNode 0 (hexString "00") 0 False 0 False
|
||||||
|
mappend = (<>)
|
||||||
|
|
||||||
|
instance Node SaplingNode where
|
||||||
|
getLevel = sn_level
|
||||||
|
getHash = sn_value
|
||||||
|
getPosition = sn_position
|
||||||
|
getIndex = sn_index
|
||||||
|
isFull = sn_full
|
||||||
|
isMarked = sn_mark
|
||||||
|
mkNode l p v = SaplingNode p v l True 0 False
|
||||||
|
|
||||||
|
instance Show SaplingNode where
|
||||||
|
show = show . sn_value
|
||||||
|
|
||||||
|
saplingSize :: SaplingTree -> Int64
|
||||||
|
saplingSize tree =
|
||||||
|
(if isNothing (st_left tree)
|
||||||
|
then 0
|
||||||
|
else 1) +
|
||||||
|
(if isNothing (st_right tree)
|
||||||
|
then 0
|
||||||
|
else 1) +
|
||||||
|
foldl
|
||||||
|
(\x (i, p) ->
|
||||||
|
case p of
|
||||||
|
Nothing -> x + 0
|
||||||
|
Just _ -> x + 2 ^ i)
|
||||||
|
0
|
||||||
|
(zip [1 ..] $ st_parents tree)
|
||||||
|
|
||||||
|
mkSaplingTree :: SaplingTree -> Tree SaplingNode
|
||||||
|
mkSaplingTree tree =
|
||||||
|
foldl
|
||||||
|
(\t (i, n) ->
|
||||||
|
case n of
|
||||||
|
Just n' -> prunedBranch i 0 n' <> t
|
||||||
|
Nothing -> t <> getEmptyRoot i)
|
||||||
|
leafRoot
|
||||||
|
(zip [1 ..] $ st_parents tree)
|
||||||
|
where
|
||||||
|
leafRoot =
|
||||||
|
case st_right tree of
|
||||||
|
Just r' -> leaf (fromJust $ st_left tree) (pos - 1) 0 <> leaf r' pos 0
|
||||||
|
Nothing -> leaf (fromJust $ st_left tree) pos 0 <> EmptyLeaf
|
||||||
|
pos = fromIntegral $ saplingSize tree - 1
|
||||||
|
|
||||||
|
-- | Orchard
|
||||||
data OrchardNode = OrchardNode
|
data OrchardNode = OrchardNode
|
||||||
{ on_position :: !Position
|
{ on_position :: !Position
|
||||||
, on_value :: !HexString
|
, on_value :: !HexString
|
||||||
|
|
@ -186,6 +296,7 @@ instance Node OrchardNode where
|
||||||
getLevel = on_level
|
getLevel = on_level
|
||||||
getHash = on_value
|
getHash = on_value
|
||||||
getPosition = on_position
|
getPosition = on_position
|
||||||
|
getIndex = on_index
|
||||||
isFull = on_full
|
isFull = on_full
|
||||||
isMarked = on_mark
|
isMarked = on_mark
|
||||||
mkNode l p v = OrchardNode p v l True 0 False
|
mkNode l p v = OrchardNode p v l True 0 False
|
||||||
|
|
|
||||||
630
test/Spec.hs
630
test/Spec.hs
|
|
@ -7,6 +7,7 @@ import Data.Aeson
|
||||||
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
|
import Data.HexString
|
||||||
|
import Data.List (foldl')
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
|
|
@ -28,7 +29,12 @@ import ZcashHaskell.Orchard
|
||||||
import ZcashHaskell.Sapling
|
import ZcashHaskell.Sapling
|
||||||
( decodeSaplingOutputEsk
|
( decodeSaplingOutputEsk
|
||||||
, encodeSaplingAddress
|
, encodeSaplingAddress
|
||||||
|
, getSaplingFrontier
|
||||||
, getSaplingNotePosition
|
, getSaplingNotePosition
|
||||||
|
, getSaplingPathAnchor
|
||||||
|
, getSaplingRootTest
|
||||||
|
, getSaplingTreeAnchor
|
||||||
|
, getSaplingTreeParts
|
||||||
, getSaplingWitness
|
, getSaplingWitness
|
||||||
, isValidShieldedAddress
|
, isValidShieldedAddress
|
||||||
, updateSaplingCommitmentTree
|
, updateSaplingCommitmentTree
|
||||||
|
|
@ -46,8 +52,10 @@ import ZcashHaskell.Types
|
||||||
, OrchardTree(..)
|
, OrchardTree(..)
|
||||||
, Phrase(..)
|
, Phrase(..)
|
||||||
, SaplingCommitmentTree(..)
|
, SaplingCommitmentTree(..)
|
||||||
|
, SaplingFrontier(..)
|
||||||
, SaplingReceiver(..)
|
, SaplingReceiver(..)
|
||||||
, SaplingSpendingKey(..)
|
, SaplingSpendingKey(..)
|
||||||
|
, SaplingTree(..)
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ShieldedOutput(..)
|
, ShieldedOutput(..)
|
||||||
, TxError(..)
|
, TxError(..)
|
||||||
|
|
@ -203,190 +211,452 @@ main = do
|
||||||
a `shouldBe`
|
a `shouldBe`
|
||||||
Just
|
Just
|
||||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||||
describe "Witnesses" $ do
|
describe "Tree loading" $ do
|
||||||
describe "Sapling" $ do
|
it "Sapling tree" $ do
|
||||||
it "max output id" $ do
|
let tree =
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
SaplingCommitmentTree $
|
||||||
sId <- getMaxSaplingNote pool
|
hexString
|
||||||
sId `shouldBe` toSqlKey 0
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
describe "Notes" $ do
|
case getSaplingTreeParts tree of
|
||||||
xit "Check Orchard notes" $ do
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
Just t1 -> do
|
||||||
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
pool <- runNoLoggingT $ initPool "test.db"
|
||||||
oNotes `shouldBe` []
|
let newTree = mkSaplingTree t1
|
||||||
xit "Check Sapling notes" $ do
|
_ <- upsertSaplingTree pool 2000 newTree
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
readTree <- getSaplingTree pool
|
||||||
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
case readTree of
|
||||||
oNotes `shouldBe` []
|
Nothing -> assertFailure "Couldn't retrieve tree from db"
|
||||||
xit "Check transparent notes" $ do
|
Just (t1, x) -> t1 `shouldBe` newTree
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
it "Sapling tree update" $ do
|
||||||
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
let tree =
|
||||||
oNotes `shouldBe` []
|
SaplingCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
|
let cmu1 =
|
||||||
|
hexString
|
||||||
|
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
|
||||||
|
case getSaplingTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
pool <- runNoLoggingT $ initPool "test.db"
|
||||||
|
let newTree = mkSaplingTree t1
|
||||||
|
_ <- upsertSaplingTree pool 2000 newTree
|
||||||
|
let updatedTree = append newTree (cmu1, 4)
|
||||||
|
_ <- upsertSaplingTree pool 2001 updatedTree
|
||||||
|
readTree <- getSaplingTree pool
|
||||||
|
case readTree of
|
||||||
|
Nothing -> assertFailure "Couldn't retrieve tree from db"
|
||||||
|
Just (t1, x) -> t1 `shouldBe` updatedTree
|
||||||
|
it "Orchard tree" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
pool <- runNoLoggingT $ initPool "test.db"
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
_ <- upsertOrchardTree pool 2000 newTree
|
||||||
|
readTree <- getOrchardTree pool
|
||||||
|
case readTree of
|
||||||
|
Nothing -> assertFailure "Couldn't retrieve tree from db"
|
||||||
|
Just (t1, x) -> t1 `shouldBe` newTree
|
||||||
|
it "Orchard tree update" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
pool <- runNoLoggingT $ initPool "test.db"
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
_ <- upsertOrchardTree pool 2000 newTree
|
||||||
|
let updatedTree = append newTree (cmx1, 4)
|
||||||
|
_ <- upsertOrchardTree pool 2001 updatedTree
|
||||||
|
readTree <- getOrchardTree pool
|
||||||
|
case readTree of
|
||||||
|
Nothing -> assertFailure "Couldn't retrieve tree from db"
|
||||||
|
Just (t1, x) -> t1 `shouldBe` updatedTree
|
||||||
describe "Tree tests" $ do
|
describe "Tree tests" $ do
|
||||||
let cmx1 =
|
describe "Sapling" $ do
|
||||||
hexString
|
|
||||||
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
|
|
||||||
let cmx2 =
|
|
||||||
hexString
|
|
||||||
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07"
|
|
||||||
let t0 = EmptyLeaf <> EmptyLeaf :: Tree OrchardNode
|
|
||||||
let t1 = t0 <> EmptyLeaf :: Tree OrchardNode
|
|
||||||
let t1a = t0 <> t0
|
|
||||||
it "Create leaf" $ do
|
|
||||||
let n = leaf cmx1 0 0 :: Tree OrchardNode
|
|
||||||
getLevel (value n) `shouldBe` 0
|
|
||||||
it "Create minimal tree" $ do
|
|
||||||
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode
|
|
||||||
getLevel (value t) `shouldBe` 1
|
|
||||||
it "Create minimal empty tree" $ do
|
|
||||||
getHash (value t0) `shouldNotBe` hexString "00"
|
|
||||||
it "Expand empty tree" $ do t1 `shouldBe` t1a
|
|
||||||
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
|
|
||||||
it "Validate empty tree" $ do
|
|
||||||
getHash (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe`
|
|
||||||
getOrchardRootTest 32
|
|
||||||
it "Validate tree with one leaf" $ do
|
|
||||||
let n = leaf cmx1 0 1 :: Tree OrchardNode
|
|
||||||
let n1 = root n
|
|
||||||
getHash (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1)
|
|
||||||
it "Validate size of tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
OrchardCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
|
||||||
case getOrchardTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get parts"
|
|
||||||
Just t1 -> do
|
|
||||||
case getOrchardFrontier tree of
|
|
||||||
Nothing -> assertFailure "Failed to get frontier"
|
|
||||||
Just f1 -> do
|
|
||||||
orchardSize t1 `shouldBe` 1 + fromIntegral (of_pos f1)
|
|
||||||
it "Deserialize commitment tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
OrchardCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
|
||||||
case getOrchardTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get frontier"
|
|
||||||
Just t1 -> do
|
|
||||||
length (ot_parents t1) `shouldBe` 31
|
|
||||||
it "Create commitment tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
OrchardCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
|
||||||
case getOrchardTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
|
||||||
Just t1 -> do
|
|
||||||
let newTree = mkOrchardTree t1
|
|
||||||
getLevel (value newTree) `shouldBe` 32
|
|
||||||
it "Validate commitment tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
OrchardCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
|
||||||
case getOrchardTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
|
||||||
Just t1 -> do
|
|
||||||
let newTree = mkOrchardTree t1
|
|
||||||
let ctAnchor = getOrchardTreeAnchor tree
|
|
||||||
{-
|
|
||||||
-getHash (value newTree) `shouldBe` ctAnchor
|
|
||||||
-isFull (value newTree) `shouldBe` False
|
|
||||||
-}
|
|
||||||
getPosition (value newTree) `shouldBe` 39733
|
|
||||||
it "Validate appending nodes to tree" $ do
|
|
||||||
let tree =
|
|
||||||
OrchardCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
|
||||||
let cmx1 =
|
let cmx1 =
|
||||||
hexString
|
hexString
|
||||||
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17"
|
||||||
let cmx2 =
|
let t0 = EmptyLeaf <> EmptyLeaf :: Tree SaplingNode
|
||||||
hexString
|
let t1 = t0 <> EmptyLeaf :: Tree SaplingNode
|
||||||
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
let t1a = t0 <> t0
|
||||||
let cmx3 =
|
it "Create leaf" $ do
|
||||||
hexString
|
let n = leaf cmx1 0 0 :: Tree SaplingNode
|
||||||
"84f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f" :: OrchardCommitment
|
getLevel (value n) `shouldBe` 0
|
||||||
let cmx4 =
|
it "Create minimal tree" $ do
|
||||||
hexString
|
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree SaplingNode
|
||||||
"e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d429" :: OrchardCommitment
|
getLevel (value t) `shouldBe` 1
|
||||||
let finalTree =
|
it "Create minimal empty tree" $ do
|
||||||
OrchardCommitmentTree $
|
getHash (value t0) `shouldNotBe` hexString "00"
|
||||||
hexString
|
it "Expand empty tree" $ do t1 `shouldBe` t1a
|
||||||
"0184f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f01e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d4291f0000014b1a76d3820087b26cd087ca84e17f3067a25ebed82ad23a93fa485affb5530b01ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
|
||||||
case getOrchardTreeParts tree of
|
it "Validate empty tree" $ do
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
getHash (value (getEmptyRoot 32 :: Tree SaplingNode)) `shouldBe`
|
||||||
Just t1 -> do
|
getSaplingRootTest 32
|
||||||
let newTree = mkOrchardTree t1
|
it "Validate size of tree from Zebra" $ do
|
||||||
let updatedTree1 = append newTree (cmx1, 4)
|
let tree =
|
||||||
let updatedTree2 = append updatedTree1 (cmx2, 5)
|
SaplingCommitmentTree $
|
||||||
let updatedTree3 = append updatedTree2 (cmx3, 6)
|
hexString
|
||||||
let updatedTree4 = append updatedTree3 (cmx4, 7)
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
let finalAnchor = getOrchardTreeAnchor finalTree
|
case getSaplingTreeParts tree of
|
||||||
getHash (value updatedTree4) `shouldBe` finalAnchor
|
Nothing -> assertFailure "Failed to get parts"
|
||||||
it "Validate serializing tree to bytes" $ do
|
Just t1 -> do
|
||||||
let tree =
|
case getSaplingFrontier tree of
|
||||||
OrchardCommitmentTree $
|
Nothing -> assertFailure "Failed to get frontier"
|
||||||
hexString
|
Just f1 -> do
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
saplingSize t1 `shouldBe` 1 + fromIntegral (sf_pos f1)
|
||||||
case mkOrchardTree <$> getOrchardTreeParts tree of
|
it "Deserialize commitment tree from Zebra" $ do
|
||||||
Nothing -> assertFailure "Failed to build tree"
|
let tree =
|
||||||
Just t1 -> do
|
SaplingCommitmentTree $
|
||||||
let treeBytes = serialiseBorsh t1
|
hexString
|
||||||
LBS.length treeBytes `shouldNotBe` 0
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
it "Validate deserializing tree from bytes" $ do
|
case getSaplingTreeParts tree of
|
||||||
let tree =
|
Nothing -> assertFailure "Failed to get frontier"
|
||||||
OrchardCommitmentTree $
|
Just t1 -> do
|
||||||
hexString
|
length (st_parents t1) `shouldBe` 31
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
it "Create commitment tree from Zebra" $ do
|
||||||
case mkOrchardTree <$> getOrchardTreeParts tree of
|
let tree =
|
||||||
Nothing -> assertFailure "Failed to build tree"
|
SaplingCommitmentTree $
|
||||||
Just t1 -> do
|
hexString
|
||||||
let treeBytes = serialiseBorsh t1
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
let rebuiltTree = deserialiseBorsh treeBytes
|
case getSaplingTreeParts tree of
|
||||||
rebuiltTree `shouldBe` Right t1
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
it "Create merkle path" $ do
|
Just t1 -> do
|
||||||
let tree =
|
let newTree = mkSaplingTree t1
|
||||||
OrchardCommitmentTree $
|
getLevel (value newTree) `shouldBe` 32
|
||||||
hexString
|
it "Validate commitment tree from Zebra" $ do
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
let tree =
|
||||||
let cmx1 =
|
SaplingCommitmentTree $
|
||||||
hexString
|
hexString
|
||||||
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
let cmx2 =
|
case getSaplingTreeParts tree of
|
||||||
hexString
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
Just t1 -> do
|
||||||
case getOrchardTreeParts tree of
|
let newTree = mkSaplingTree t1
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
let ctAnchor = getSaplingTreeAnchor tree
|
||||||
Just t1 -> do
|
{-
|
||||||
let newTree = mkOrchardTree t1
|
-getHash (value newTree) `shouldBe` ctAnchor
|
||||||
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
-isFull (value newTree) `shouldBe` False
|
||||||
case path 39735 updatedTree of
|
-}
|
||||||
Nothing -> assertFailure "Failed to get Merkle path"
|
getPosition (value newTree) `shouldBe` 145761
|
||||||
Just p1 -> p1 `shouldNotBe` MerklePath 0 []
|
it "Validate appending nodes to tree" $ do
|
||||||
it "Validate merkle path" $ do
|
let tree =
|
||||||
let tree =
|
SaplingCommitmentTree $
|
||||||
OrchardCommitmentTree $
|
hexString
|
||||||
hexString
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
let cmu1 =
|
||||||
let cmx1 =
|
hexString
|
||||||
hexString
|
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
|
||||||
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
let finalTree =
|
||||||
let cmx2 =
|
SaplingCommitmentTree $
|
||||||
hexString
|
hexString
|
||||||
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
"01238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17001f01fff1bcef0a4485a0beafb4813a3fd7fc7402c5efde08f56a8bb9ac99aa25ef4e000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
case getOrchardTreeParts tree of
|
case getSaplingTreeParts tree of
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
Just t1 -> do
|
Just t1 -> do
|
||||||
let newTree = mkOrchardTree t1
|
let newTree = mkSaplingTree t1
|
||||||
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
let updatedTree1 = append newTree (cmu1, 4)
|
||||||
case path 39735 updatedTree of
|
let finalAnchor = getSaplingTreeAnchor finalTree
|
||||||
Nothing -> assertFailure "Failed to get Merkle path"
|
getHash (value updatedTree1) `shouldBe` finalAnchor
|
||||||
Just p1 -> do
|
it "Validate serializing tree to bytes" $ do
|
||||||
getOrchardPathAnchor cmx2 p1 `shouldBe`
|
let tree =
|
||||||
|
SaplingCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
|
case mkSaplingTree <$> getSaplingTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to build tree"
|
||||||
|
Just t1 -> do
|
||||||
|
let treeBytes = serialiseBorsh t1
|
||||||
|
LBS.length treeBytes `shouldNotBe` 0
|
||||||
|
it "Validate deserializing tree from bytes" $ do
|
||||||
|
let tree =
|
||||||
|
SaplingCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
|
case mkSaplingTree <$> getSaplingTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to build tree"
|
||||||
|
Just t1 -> do
|
||||||
|
let treeBytes = serialiseBorsh t1
|
||||||
|
let rebuiltTree = deserialiseBorsh treeBytes
|
||||||
|
rebuiltTree `shouldBe` Right t1
|
||||||
|
it "Create merkle path" $ do
|
||||||
|
let tree =
|
||||||
|
SaplingCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
|
let cmu1 =
|
||||||
|
hexString
|
||||||
|
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
|
||||||
|
case getSaplingTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkSaplingTree t1
|
||||||
|
let updatedTree = append newTree (cmu1, 4)
|
||||||
|
case path 145762 updatedTree of
|
||||||
|
Nothing -> assertFailure "Failed to get Merkle path"
|
||||||
|
Just p1 -> p1 `shouldNotBe` MerklePath 0 []
|
||||||
|
it "Validate merkle path" $ do
|
||||||
|
let tree =
|
||||||
|
SaplingCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
|
let cmu1 =
|
||||||
|
hexString
|
||||||
|
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
|
||||||
|
case getSaplingTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkSaplingTree t1
|
||||||
|
let updatedTree = append newTree (cmu1, 4)
|
||||||
|
case path 145762 updatedTree of
|
||||||
|
Nothing -> assertFailure "Failed to get Merkle path"
|
||||||
|
Just p1 ->
|
||||||
|
getSaplingPathAnchor cmu1 p1 `shouldBe`
|
||||||
getHash (value updatedTree)
|
getHash (value updatedTree)
|
||||||
|
it "Find position by index" $ do
|
||||||
|
let tree =
|
||||||
|
SaplingCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
||||||
|
let cmu1 =
|
||||||
|
hexString
|
||||||
|
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
|
||||||
|
case getSaplingTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkSaplingTree t1
|
||||||
|
let updatedTree = append newTree (cmu1, 4)
|
||||||
|
getNotePosition updatedTree 4 `shouldBe` Just 145762
|
||||||
|
describe "Orchard" $ do
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07"
|
||||||
|
let t0 = EmptyLeaf <> EmptyLeaf :: Tree OrchardNode
|
||||||
|
let t1 = t0 <> EmptyLeaf :: Tree OrchardNode
|
||||||
|
let t1a = t0 <> t0
|
||||||
|
it "Create leaf" $ do
|
||||||
|
let n = leaf cmx1 0 0 :: Tree OrchardNode
|
||||||
|
getLevel (value n) `shouldBe` 0
|
||||||
|
it "Create minimal tree" $ do
|
||||||
|
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree OrchardNode
|
||||||
|
getLevel (value t) `shouldBe` 1
|
||||||
|
it "Create minimal empty tree" $ do
|
||||||
|
getHash (value t0) `shouldNotBe` hexString "00"
|
||||||
|
it "Expand empty tree" $ do t1 `shouldBe` t1a
|
||||||
|
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
|
||||||
|
it "Validate empty tree" $ do
|
||||||
|
getHash (value (getEmptyRoot 32 :: Tree OrchardNode)) `shouldBe`
|
||||||
|
getOrchardRootTest 32
|
||||||
|
it "Validate tree with one leaf" $ do
|
||||||
|
let n = leaf cmx1 0 1 :: Tree OrchardNode
|
||||||
|
let n1 = root n
|
||||||
|
getHash (value n1) `shouldBe` addOrchardNodeGetRoot 32 (hexBytes cmx1)
|
||||||
|
it "Validate size of tree from Zebra" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get parts"
|
||||||
|
Just t1 -> do
|
||||||
|
case getOrchardFrontier tree of
|
||||||
|
Nothing -> assertFailure "Failed to get frontier"
|
||||||
|
Just f1 -> do
|
||||||
|
orchardSize t1 `shouldBe` 1 + fromIntegral (of_pos f1)
|
||||||
|
it "Deserialize commitment tree from Zebra" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get frontier"
|
||||||
|
Just t1 -> do
|
||||||
|
length (ot_parents t1) `shouldBe` 31
|
||||||
|
it "Create commitment tree from Zebra" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
getLevel (value newTree) `shouldBe` 32
|
||||||
|
it "Validate commitment tree from Zebra" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let ctAnchor = getOrchardTreeAnchor tree
|
||||||
|
{-
|
||||||
|
-getHash (value newTree) `shouldBe` ctAnchor
|
||||||
|
-isFull (value newTree) `shouldBe` False
|
||||||
|
-}
|
||||||
|
getPosition (value newTree) `shouldBe` 39733
|
||||||
|
it "Validate appending nodes to tree" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
let cmx3 =
|
||||||
|
hexString
|
||||||
|
"84f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f" :: OrchardCommitment
|
||||||
|
let cmx4 =
|
||||||
|
hexString
|
||||||
|
"e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d429" :: OrchardCommitment
|
||||||
|
let finalTree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0184f7fbc4b9f87215c653078d7fdd90756c3ba370c745065167da9eb73a65a83f01e55ad64e1ea2b261893fdea6ad0509b66e5f62d3142f351298c7135c4498d4291f0000014b1a76d3820087b26cd087ca84e17f3067a25ebed82ad23a93fa485affb5530b01ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree1 = append newTree (cmx1, 4)
|
||||||
|
let updatedTree2 = append updatedTree1 (cmx2, 5)
|
||||||
|
let updatedTree3 = append updatedTree2 (cmx3, 6)
|
||||||
|
let updatedTree4 = append updatedTree3 (cmx4, 7)
|
||||||
|
let finalAnchor = getOrchardTreeAnchor finalTree
|
||||||
|
getHash (value updatedTree4) `shouldBe` finalAnchor
|
||||||
|
it "Validate serializing tree to bytes" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case mkOrchardTree <$> getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to build tree"
|
||||||
|
Just t1 -> do
|
||||||
|
let treeBytes = serialiseBorsh t1
|
||||||
|
LBS.length treeBytes `shouldNotBe` 0
|
||||||
|
it "Validate deserializing tree from bytes" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
case mkOrchardTree <$> getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to build tree"
|
||||||
|
Just t1 -> do
|
||||||
|
let treeBytes = serialiseBorsh t1
|
||||||
|
let rebuiltTree = deserialiseBorsh treeBytes
|
||||||
|
rebuiltTree `shouldBe` Right t1
|
||||||
|
it "Create merkle path" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
|
case path 39735 updatedTree of
|
||||||
|
Nothing -> assertFailure "Failed to get Merkle path"
|
||||||
|
Just p1 -> p1 `shouldNotBe` MerklePath 0 []
|
||||||
|
it "Validate merkle path" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
|
case path 39735 updatedTree of
|
||||||
|
Nothing -> assertFailure "Failed to get Merkle path"
|
||||||
|
Just p1 -> do
|
||||||
|
getOrchardPathAnchor cmx2 p1 `shouldBe`
|
||||||
|
getHash (value updatedTree)
|
||||||
|
it "Find position by index" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
|
getNotePosition updatedTree 4 `shouldBe` Just 39734
|
||||||
|
it "Truncate tree" $ do
|
||||||
|
let tree =
|
||||||
|
OrchardCommitmentTree $
|
||||||
|
hexString
|
||||||
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
|
case getOrchardTreeParts tree of
|
||||||
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
|
Just t1 -> do
|
||||||
|
let newTree = mkOrchardTree t1
|
||||||
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
|
let truncTree = truncateTree updatedTree 4
|
||||||
|
getIndex (value truncTree) `shouldBe` 4
|
||||||
|
it "Validate tree from DB" $ do
|
||||||
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
|
dbTree <- getOrchardTree pool
|
||||||
|
case dbTree of
|
||||||
|
Nothing -> assertFailure "failed to get tree from DB"
|
||||||
|
Just (oTree, oSync) -> do
|
||||||
|
zebraTrees <-
|
||||||
|
getCommitmentTrees
|
||||||
|
pool
|
||||||
|
"localhost"
|
||||||
|
18232
|
||||||
|
(ZcashNetDB TestNet)
|
||||||
|
oSync
|
||||||
|
let finalAnchor =
|
||||||
|
getOrchardTreeAnchor $
|
||||||
|
OrchardCommitmentTree $ ztiOrchard zebraTrees
|
||||||
|
getHash (value oTree) `shouldBe` finalAnchor
|
||||||
describe "Creating Tx" $ do
|
describe "Creating Tx" $ do
|
||||||
describe "Full" $ do
|
describe "Full" $ do
|
||||||
it "To Orchard" $ do
|
it "To Orchard" $ do
|
||||||
|
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit 62cda9cc15621dead6fbfd7a4944840408d69da4
|
Subproject commit dea960c2acf7479eeb42845c07b482449d538aae
|
||||||
Loading…
Reference in a new issue