Compare commits
No commits in common. "f23c222edcfce55a199a860cdb221e1b3edfe0fd" and "f2f18b5b0c41a2ef6bd31f77b5f8865b98c39991" have entirely different histories.
f23c222edc
...
f2f18b5b0c
9 changed files with 381 additions and 990 deletions
|
|
@ -870,16 +870,9 @@ 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 do
|
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||||
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
|
||||||
|
|
@ -927,8 +920,28 @@ appEvent (BT.AppEvent t) = do
|
||||||
TickMsg m -> do
|
TickMsg m -> do
|
||||||
case s ^. displayBox of
|
case s ^. displayBox of
|
||||||
AddrDisplay -> return ()
|
AddrDisplay -> return ()
|
||||||
MsgDisplay -> do
|
MsgDisplay -> return ()
|
||||||
if m == "startSync"
|
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
|
then do
|
||||||
selWallet <-
|
selWallet <-
|
||||||
do case L.listSelectedElement $ s ^. wallets of
|
do case L.listSelectedElement $ s ^. wallets of
|
||||||
|
|
@ -955,34 +968,8 @@ 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
|
||||||
|
|
@ -1003,9 +990,7 @@ 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 <-
|
sBlock <- liftIO $ getMinBirthdayHeight pool
|
||||||
liftIO $
|
|
||||||
getMinBirthdayHeight pool (ZcashNetDB $ s ^. network)
|
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
forkIO $
|
forkIO $
|
||||||
|
|
@ -1230,7 +1215,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
(s ^. zebraPort)
|
(s ^. zebraPort)
|
||||||
(s ^. network)
|
(s ^. network)
|
||||||
(entityKey selAcc)
|
(entityKey selAcc)
|
||||||
bl
|
(bl + 5)
|
||||||
(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 (Int32, Int64)
|
import Data.Int (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,7 +50,6 @@ import ZcashHaskell.Orchard
|
||||||
, genOrchardSpendingKey
|
, genOrchardSpendingKey
|
||||||
, getOrchardFrontier
|
, getOrchardFrontier
|
||||||
, getOrchardNotePosition
|
, getOrchardNotePosition
|
||||||
, getOrchardTreeParts
|
|
||||||
, getOrchardWitness
|
, getOrchardWitness
|
||||||
, isValidUnifiedAddress
|
, isValidUnifiedAddress
|
||||||
, updateOrchardCommitmentTree
|
, updateOrchardCommitmentTree
|
||||||
|
|
@ -63,7 +62,6 @@ import ZcashHaskell.Sapling
|
||||||
, genSaplingSpendingKey
|
, genSaplingSpendingKey
|
||||||
, getSaplingFrontier
|
, getSaplingFrontier
|
||||||
, getSaplingNotePosition
|
, getSaplingNotePosition
|
||||||
, getSaplingTreeParts
|
|
||||||
, getSaplingWitness
|
, getSaplingWitness
|
||||||
, updateSaplingCommitmentTree
|
, updateSaplingCommitmentTree
|
||||||
, updateSaplingWitness
|
, updateSaplingWitness
|
||||||
|
|
@ -76,7 +74,6 @@ 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(..)
|
||||||
|
|
@ -306,48 +303,66 @@ 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
|
||||||
sT <- liftIO $ getSaplingTree pool
|
trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
|
||||||
|
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', treeSync) -> do
|
Just sT' -> do
|
||||||
logDebugN "Sapling tree valid"
|
logDebugN "Sapling frontier valid"
|
||||||
mapM_ (decryptNotes sT' zn pool) tList
|
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 ::
|
||||||
Tree SaplingNode
|
SaplingFrontier
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ConnectionPool
|
-> ConnectionPool
|
||||||
-> (Entity ZcashTransaction, Entity ShieldOutput)
|
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
||||||
-> NoLoggingT IO ()
|
-> NoLoggingT IO ()
|
||||||
decryptNotes st n pool (zt, o) = do
|
decryptNotes _ _ _ [] = return ()
|
||||||
case getNotePosition st $ fromSqlKey $ entityKey o of
|
decryptNotes st n pool ((zt, o):txs) = do
|
||||||
Nothing -> do
|
let updatedTree =
|
||||||
logErrorN "Couldn't find sapling note in commitment tree"
|
updateSaplingCommitmentTree
|
||||||
return ()
|
st
|
||||||
Just nP -> do
|
(getHex $ shieldOutputCmu $ entityVal o)
|
||||||
|
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
|
||||||
|
Nothing ->
|
||||||
|
liftIO $ throwIO $ userError "Failed to obtain note position"
|
||||||
|
Just nP -> do
|
||||||
case decodeShOut External n nP o of
|
case decodeShOut External n nP o of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
logDebugN "couldn't decode external"
|
logDebugN "couldn't decode external"
|
||||||
case decodeShOut Internal n nP o of
|
case decodeShOut Internal n nP o of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
logDebugN "couldn't decode internal"
|
logDebugN "couldn't decode internal"
|
||||||
|
decryptNotes uT n pool txs
|
||||||
Just dn1 -> do
|
Just dn1 -> 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
|
True
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn1
|
dn1
|
||||||
|
decryptNotes uT n pool txs
|
||||||
Just dn0 -> do
|
Just dn0 -> do
|
||||||
wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
|
wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
|
||||||
liftIO $
|
liftIO $
|
||||||
|
|
@ -355,12 +370,18 @@ findSaplingOutputs config b znet za = do
|
||||||
pool
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
|
(fromJust noteWitness)
|
||||||
False
|
False
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn0
|
dn0
|
||||||
|
decryptNotes uT n pool txs
|
||||||
decodeShOut ::
|
decodeShOut ::
|
||||||
Scope -> ZcashNet -> Int32 -> Entity ShieldOutput -> Maybe DecodedNote
|
Scope
|
||||||
|
-> ZcashNet
|
||||||
|
-> Integer
|
||||||
|
-> Entity ShieldOutput
|
||||||
|
-> Maybe DecodedNote
|
||||||
decodeShOut scope n pos s = do
|
decodeShOut scope n pos s = do
|
||||||
decodeSaplingOutputEsk
|
decodeSaplingOutputEsk
|
||||||
(getSapSK sk)
|
(getSapSK sk)
|
||||||
|
|
@ -373,7 +394,7 @@ findSaplingOutputs config b znet za = do
|
||||||
(getHex $ shieldOutputProof $ entityVal s))
|
(getHex $ shieldOutputProof $ entityVal s))
|
||||||
n
|
n
|
||||||
scope
|
scope
|
||||||
(fromIntegral pos)
|
pos
|
||||||
|
|
||||||
-- | Get Orchard actions
|
-- | Get Orchard actions
|
||||||
findOrchardActions ::
|
findOrchardActions ::
|
||||||
|
|
@ -389,52 +410,67 @@ 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
|
||||||
sT <- getOrchardTree pool
|
trees <- getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
|
||||||
|
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', treeSync) -> do
|
Just sT' -> do
|
||||||
mapM_ (decryptNotes sT' zn pool) tList
|
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 ::
|
||||||
Tree OrchardNode
|
OrchardFrontier
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ConnectionPool
|
-> ConnectionPool
|
||||||
-> (Entity ZcashTransaction, Entity OrchAction)
|
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
||||||
-> IO ()
|
-> IO ()
|
||||||
decryptNotes ot n pool (zt, o) = do
|
decryptNotes _ _ _ [] = return ()
|
||||||
case getNotePosition ot (fromSqlKey $ entityKey o) of
|
decryptNotes ot n pool ((zt, o):txs) = do
|
||||||
Nothing -> do
|
let updatedTree =
|
||||||
return ()
|
updateOrchardCommitmentTree
|
||||||
|
ot
|
||||||
|
(getHex $ orchActionCmx $ entityVal o)
|
||||||
|
case updatedTree of
|
||||||
|
Nothing -> throwIO $ userError "Failed to update commitment tree"
|
||||||
|
Just uT -> do
|
||||||
|
let noteWitness = getOrchardWitness uT
|
||||||
|
let notePos = getOrchardNotePosition <$> noteWitness
|
||||||
|
case notePos of
|
||||||
|
Nothing -> throwIO $ userError "Failed to obtain note position"
|
||||||
Just nP ->
|
Just nP ->
|
||||||
case decodeOrchAction External nP o of
|
case decodeOrchAction External nP o of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
case decodeOrchAction Internal nP o of
|
case decodeOrchAction Internal nP o of
|
||||||
Nothing -> return ()
|
Nothing -> decryptNotes uT n pool txs
|
||||||
Just dn1 -> do
|
Just dn1 -> do
|
||||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
saveWalletOrchNote
|
saveWalletOrchNote
|
||||||
pool
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
|
(fromJust noteWitness)
|
||||||
True
|
True
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn1
|
dn1
|
||||||
|
decryptNotes uT n pool txs
|
||||||
Just dn -> do
|
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)
|
||||||
False
|
False
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn
|
dn
|
||||||
|
decryptNotes uT n pool txs
|
||||||
sk :: OrchardSpendingKeyDB
|
sk :: OrchardSpendingKeyDB
|
||||||
sk = zcashAccountOrchSpendKey $ entityVal za
|
sk = zcashAccountOrchSpendKey $ entityVal za
|
||||||
decodeOrchAction :: Scope -> Int32 -> Entity OrchAction -> Maybe DecodedNote
|
decodeOrchAction ::
|
||||||
|
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
|
||||||
decodeOrchAction scope pos o =
|
decodeOrchAction scope pos o =
|
||||||
decryptOrchardActionSK (getOrchSK sk) scope $
|
decryptOrchardActionSK (getOrchSK sk) scope $
|
||||||
OrchardAction
|
OrchardAction
|
||||||
|
|
@ -778,6 +814,11 @@ 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"
|
||||||
|
|
@ -790,8 +831,6 @@ 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 <-
|
||||||
|
|
@ -825,8 +864,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
tx <-
|
tx <-
|
||||||
liftIO $
|
liftIO $
|
||||||
createTransaction
|
createTransaction
|
||||||
(maybe (hexString "00") (getHash . value . fst) sTree)
|
Nothing
|
||||||
(maybe (hexString "00") (getHash . value . fst) oTree)
|
Nothing
|
||||||
tSpends
|
tSpends
|
||||||
[]
|
[]
|
||||||
[]
|
[]
|
||||||
|
|
@ -892,8 +931,10 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
let recipients = map extractReceiver pnotes
|
let recipients = map extractReceiver pnotes
|
||||||
logDebugN $ T.pack $ show recipients
|
logDebugN $ T.pack $ show recipients
|
||||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||||
sTree <- liftIO $ getSaplingTree pool
|
trees <-
|
||||||
oTree <- liftIO $ getOrchardTree pool
|
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) 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"
|
||||||
|
|
@ -928,6 +969,24 @@ 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
|
||||||
|
|
@ -963,13 +1022,11 @@ 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' <-
|
||||||
|
|
@ -986,14 +1043,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||||
tx <-
|
tx <-
|
||||||
liftIO $
|
liftIO $
|
||||||
createTransaction
|
createTransaction
|
||||||
(maybe
|
(Just sT)
|
||||||
(hexString "00")
|
(Just oT)
|
||||||
(getHash . value . fst)
|
|
||||||
sTree)
|
|
||||||
(maybe
|
|
||||||
(hexString "00")
|
|
||||||
(getHash . value . fst)
|
|
||||||
oTree)
|
|
||||||
tSpends1
|
tSpends1
|
||||||
sSpends1
|
sSpends1
|
||||||
oSpends1
|
oSpends1
|
||||||
|
|
@ -1249,16 +1300,9 @@ 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
|
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||||
-> Tree SaplingNode
|
prepSSpends sk notes = do
|
||||||
-> [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)
|
||||||
|
|
@ -1269,18 +1313,11 @@ 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))
|
||||||
(fromMaybe nullPath notePath)
|
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||||
prepOSpends ::
|
prepOSpends ::
|
||||||
OrchardSpendingKey
|
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||||
-> Tree OrchardNode
|
prepOSpends sk notes = do
|
||||||
-> [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)
|
||||||
|
|
@ -1291,7 +1328,21 @@ 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))
|
||||||
(fromMaybe nullPath notePath)
|
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||||
|
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
|
||||||
|
sapAnchor notes =
|
||||||
|
if not (null notes)
|
||||||
|
then Just $
|
||||||
|
SaplingWitness $
|
||||||
|
getHex $ walletSapNoteWitness $ entityVal $ head notes
|
||||||
|
else Nothing
|
||||||
|
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
|
||||||
|
orchAnchor notes =
|
||||||
|
if not (null notes)
|
||||||
|
then Just $
|
||||||
|
OrchardWitness $
|
||||||
|
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||||
|
else Nothing
|
||||||
|
|
||||||
-- | Sync the wallet with the data store
|
-- | Sync the wallet with the data store
|
||||||
syncWallet ::
|
syncWallet ::
|
||||||
|
|
@ -1337,95 +1388,10 @@ 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,7 +18,6 @@
|
||||||
|
|
||||||
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)
|
||||||
|
|
@ -26,7 +25,6 @@ import Control.Monad.Logger
|
||||||
( LoggingT
|
( LoggingT
|
||||||
, NoLoggingT
|
, NoLoggingT
|
||||||
, logDebugN
|
, logDebugN
|
||||||
, logErrorN
|
|
||||||
, runNoLoggingT
|
, runNoLoggingT
|
||||||
, runStderrLoggingT
|
, runStderrLoggingT
|
||||||
)
|
)
|
||||||
|
|
@ -82,7 +80,6 @@ import ZcashHaskell.Types
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
import Zenith.Tree (OrchardNode(..), SaplingNode(..), Tree(..), truncateTree)
|
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AccountBalance(..)
|
( AccountBalance(..)
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
|
|
@ -307,12 +304,6 @@ 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
|
||||||
|
|
@ -928,17 +919,15 @@ getMaxWalletBlock pool = do
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ walletTransactionBlock $ entityVal x
|
Just x -> return $ walletTransactionBlock $ entityVal x
|
||||||
|
|
||||||
getMinBirthdayHeight :: ConnectionPool -> ZcashNetDB -> IO Int
|
getMinBirthdayHeight :: ConnectionPool -> IO Int
|
||||||
getMinBirthdayHeight pool znet = do
|
getMinBirthdayHeight pool = 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_
|
where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
|
||||||
(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
|
||||||
|
|
@ -994,13 +983,14 @@ 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
|
||||||
-> Int32 -- ^ note position
|
-> Integer -- ^ 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 ch za zt dn = do
|
saveWalletSapNote pool wId pos wit ch za zt dn = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
|
@ -1015,7 +1005,7 @@ saveWalletSapNote pool wId pos ch za zt dn = do
|
||||||
False
|
False
|
||||||
(HexStringDB $ a_nullifier dn)
|
(HexStringDB $ a_nullifier dn)
|
||||||
(fromIntegral pos)
|
(fromIntegral pos)
|
||||||
(HexStringDB $ hexString "00")
|
(HexStringDB $ sapWit wit)
|
||||||
ch
|
ch
|
||||||
zt
|
zt
|
||||||
(RseedDB $ a_rseed dn))
|
(RseedDB $ a_rseed dn))
|
||||||
|
|
@ -1026,13 +1016,14 @@ saveWalletSapNote pool wId pos ch za zt dn = do
|
||||||
saveWalletOrchNote ::
|
saveWalletOrchNote ::
|
||||||
ConnectionPool
|
ConnectionPool
|
||||||
-> WalletTransactionId
|
-> WalletTransactionId
|
||||||
-> Int32
|
-> Integer
|
||||||
|
-> OrchardWitness
|
||||||
-> Bool
|
-> Bool
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> OrchActionId
|
-> OrchActionId
|
||||||
-> DecodedNote
|
-> DecodedNote
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletOrchNote pool wId pos ch za zt dn = do
|
saveWalletOrchNote pool wId pos wit ch za zt dn = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
|
@ -1047,7 +1038,7 @@ saveWalletOrchNote pool wId pos ch za zt dn = do
|
||||||
False
|
False
|
||||||
(HexStringDB $ a_nullifier dn)
|
(HexStringDB $ a_nullifier dn)
|
||||||
(fromIntegral pos)
|
(fromIntegral pos)
|
||||||
(HexStringDB $ hexString "00")
|
(HexStringDB $ orchWit wit)
|
||||||
ch
|
ch
|
||||||
zt
|
zt
|
||||||
(a_rho dn)
|
(a_rho dn)
|
||||||
|
|
@ -2168,9 +2159,6 @@ 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 ()
|
||||||
|
|
@ -2824,173 +2812,7 @@ 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 ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
(blk ^. ZcashBlockNetwork ==. val net)
|
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 $ ZcashNetDB net
|
b <- liftIO $ getMinBirthdayHeight pool
|
||||||
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 $ ZcashNetDB net
|
b <- getMinBirthdayHeight pool
|
||||||
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, updateCommitmentTrees)
|
import Zenith.Core (checkBlockChain, syncWallet)
|
||||||
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 znet
|
b <- liftIO $ getMinBirthdayHeight pool1
|
||||||
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,7 +108,6 @@ 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,13 +15,7 @@ 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.Sapling (combineSaplingNodes, getSaplingNodeValue)
|
import ZcashHaskell.Types (MerklePath(..), OrchardFrontier(..), OrchardTree(..))
|
||||||
import ZcashHaskell.Types
|
|
||||||
( MerklePath(..)
|
|
||||||
, OrchardFrontier(..)
|
|
||||||
, OrchardTree(..)
|
|
||||||
, SaplingTree(..)
|
|
||||||
)
|
|
||||||
|
|
||||||
type Level = Int8
|
type Level = Int8
|
||||||
|
|
||||||
|
|
@ -39,7 +33,6 @@ 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
|
||||||
|
|
@ -52,14 +45,6 @@ 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
|
||||||
|
|
@ -103,7 +88,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 = InvalidTree
|
| isFull s = Branch s x y <> mkSubTree (getLevel s) (Leaf w)
|
||||||
| 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)
|
||||||
|
|
@ -166,101 +151,6 @@ 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
|
||||||
|
|
@ -296,7 +186,6 @@ 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
|
||||||
|
|
|
||||||
308
test/Spec.hs
308
test/Spec.hs
|
|
@ -7,7 +7,6 @@ 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
|
||||||
|
|
@ -29,12 +28,7 @@ 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
|
||||||
|
|
@ -52,10 +46,8 @@ import ZcashHaskell.Types
|
||||||
, OrchardTree(..)
|
, OrchardTree(..)
|
||||||
, Phrase(..)
|
, Phrase(..)
|
||||||
, SaplingCommitmentTree(..)
|
, SaplingCommitmentTree(..)
|
||||||
, SaplingFrontier(..)
|
|
||||||
, SaplingReceiver(..)
|
, SaplingReceiver(..)
|
||||||
, SaplingSpendingKey(..)
|
, SaplingSpendingKey(..)
|
||||||
, SaplingTree(..)
|
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ShieldedOutput(..)
|
, ShieldedOutput(..)
|
||||||
, TxError(..)
|
, TxError(..)
|
||||||
|
|
@ -211,236 +203,26 @@ main = do
|
||||||
a `shouldBe`
|
a `shouldBe`
|
||||||
Just
|
Just
|
||||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||||
describe "Tree loading" $ do
|
describe "Witnesses" $ do
|
||||||
it "Sapling tree" $ do
|
|
||||||
let tree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
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
|
|
||||||
readTree <- getSaplingTree pool
|
|
||||||
case readTree of
|
|
||||||
Nothing -> assertFailure "Couldn't retrieve tree from db"
|
|
||||||
Just (t1, x) -> t1 `shouldBe` newTree
|
|
||||||
it "Sapling tree update" $ 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
|
|
||||||
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 "Sapling" $ do
|
describe "Sapling" $ do
|
||||||
let cmx1 =
|
it "max output id" $ do
|
||||||
hexString
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17"
|
sId <- getMaxSaplingNote pool
|
||||||
let t0 = EmptyLeaf <> EmptyLeaf :: Tree SaplingNode
|
sId `shouldBe` toSqlKey 0
|
||||||
let t1 = t0 <> EmptyLeaf :: Tree SaplingNode
|
describe "Notes" $ do
|
||||||
let t1a = t0 <> t0
|
xit "Check Orchard notes" $ do
|
||||||
it "Create leaf" $ do
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
let n = leaf cmx1 0 0 :: Tree SaplingNode
|
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
||||||
getLevel (value n) `shouldBe` 0
|
oNotes `shouldBe` []
|
||||||
it "Create minimal tree" $ do
|
xit "Check Sapling notes" $ do
|
||||||
let t = leaf cmx1 0 0 <> EmptyLeaf :: Tree SaplingNode
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
getLevel (value t) `shouldBe` 1
|
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
||||||
it "Create minimal empty tree" $ do
|
oNotes `shouldBe` []
|
||||||
getHash (value t0) `shouldNotBe` hexString "00"
|
xit "Check transparent notes" $ do
|
||||||
it "Expand empty tree" $ do t1 `shouldBe` t1a
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
it "Create empty tree non-rec" $ getEmptyRoot 2 `shouldBe` t1
|
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
||||||
it "Validate empty tree" $ do
|
oNotes `shouldBe` []
|
||||||
getHash (value (getEmptyRoot 32 :: Tree SaplingNode)) `shouldBe`
|
describe "Tree tests" $ do
|
||||||
getSaplingRootTest 32
|
|
||||||
it "Validate size of tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
case getSaplingTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get parts"
|
|
||||||
Just t1 -> do
|
|
||||||
case getSaplingFrontier tree of
|
|
||||||
Nothing -> assertFailure "Failed to get frontier"
|
|
||||||
Just f1 -> do
|
|
||||||
saplingSize t1 `shouldBe` 1 + fromIntegral (sf_pos f1)
|
|
||||||
it "Deserialize commitment tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
case getSaplingTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get frontier"
|
|
||||||
Just t1 -> do
|
|
||||||
length (st_parents t1) `shouldBe` 31
|
|
||||||
it "Create commitment tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
case getSaplingTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
|
||||||
Just t1 -> do
|
|
||||||
let newTree = mkSaplingTree t1
|
|
||||||
getLevel (value newTree) `shouldBe` 32
|
|
||||||
it "Validate commitment tree from Zebra" $ do
|
|
||||||
let tree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
case getSaplingTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
|
||||||
Just t1 -> do
|
|
||||||
let newTree = mkSaplingTree t1
|
|
||||||
let ctAnchor = getSaplingTreeAnchor tree
|
|
||||||
{-
|
|
||||||
-getHash (value newTree) `shouldBe` ctAnchor
|
|
||||||
-isFull (value newTree) `shouldBe` False
|
|
||||||
-}
|
|
||||||
getPosition (value newTree) `shouldBe` 145761
|
|
||||||
it "Validate appending nodes to tree" $ do
|
|
||||||
let tree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01b4a6049100dd1aa53fd850c388e0ed3782b039448aa43de5fd41d9e2419b375b0114abe3b473ac2dcd9ec3c62ff5cffb683f2e584d70ce4c1c118d67a8c34f1d691f00000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
let cmu1 =
|
|
||||||
hexString
|
|
||||||
"238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17" :: SaplingCommitment
|
|
||||||
let finalTree =
|
|
||||||
SaplingCommitmentTree $
|
|
||||||
hexString
|
|
||||||
"01238a75ea513eb330cee527d3fa5000cd52620f116919a33afb9ac78ee1f91c17001f01fff1bcef0a4485a0beafb4813a3fd7fc7402c5efde08f56a8bb9ac99aa25ef4e000000014278a19b3777ee0ceb48c4d469ab0a95217de56f27a4eaf9f19a90244bcff05301692acd3dd617e7cb44a17026211a31899cf27ef5960d59b8323ba105c754965800016f641fd51f68efae0cb742182483d97054bca8fcfb8036b1c165acdb0b27fc1b0000015965da8d105e2d412c7e13f920e607461c8cbb67a38b3a667898d1eaa064ba5701be82b8379a88cce7629153e0b3d1bf826782d3e0c367d615d362b479ead41d6401e1dbd43a62ac601d82de803fc3b6485182854056c6577bae231882b19184b03e000000018f624406b4ebda9ee13c062063e16f65ab5d725b80645037be7760e4ca7887730000000000000000000000000000"
|
|
||||||
case getSaplingTreeParts tree of
|
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
|
||||||
Just t1 -> do
|
|
||||||
let newTree = mkSaplingTree t1
|
|
||||||
let updatedTree1 = append newTree (cmu1, 4)
|
|
||||||
let finalAnchor = getSaplingTreeAnchor finalTree
|
|
||||||
getHash (value updatedTree1) `shouldBe` finalAnchor
|
|
||||||
it "Validate serializing tree to 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
|
|
||||||
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)
|
|
||||||
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 =
|
let cmx1 =
|
||||||
hexString
|
hexString
|
||||||
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400"
|
||||||
|
|
@ -605,58 +387,6 @@ main = do
|
||||||
Just p1 -> do
|
Just p1 -> do
|
||||||
getOrchardPathAnchor cmx2 p1 `shouldBe`
|
getOrchardPathAnchor cmx2 p1 `shouldBe`
|
||||||
getHash (value updatedTree)
|
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 dea960c2acf7479eeb42845c07b482449d538aae
|
Subproject commit 62cda9cc15621dead6fbfd7a4944840408d69da4
|
||||||
Loading…
Reference in a new issue