diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index e757832..b2ca122 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -159,7 +159,7 @@ share script BS.ByteString change Bool position Int - UniqueTNote tx script + UniqueTNote tx accId script deriving Show Eq WalletTrSpend tx WalletTransactionId OnDeleteCascade OnUpdateCascade @@ -2828,24 +2828,36 @@ rewindWalletData pool b net = do (blk ^. ZcashBlockHeight >. val b) &&. (blk ^. ZcashBlockNetwork ==. val net) logDebugN "Completed data store rewind" + {- + -_ <- liftIO $ clearTrees pool + -logDebugN "Cleared commitment trees" + -} 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 + 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 + truncOrchTree <- truncateTree (maybe InvalidTree fst orchardTree) oaIx _ <- liftIO $ upsertOrchardTree pool b truncOrchTree logDebugN $ "Truncated Orchard tree at index " <> T.pack (show oaIx) +clearTrees :: ConnectionPool -> IO () +clearTrees pool = + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + delete $ do + tr <- from $ table @TreeStore + return () + getSaplingOutputAtBlock :: ConnectionPool -> ZcashNetDB -> Int -> IO (Maybe Int64) getSaplingOutputAtBlock pool znet b = do @@ -2863,10 +2875,7 @@ getSaplingOutputAtBlock pool znet b = do txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) where_ (blks ^. ZcashBlockHeight <=. val b) where_ (blks ^. ZcashBlockNetwork ==. val znet) - orderBy - [ desc $ txs ^. ZcashTransactionId - , desc $ sOutputs ^. ShieldOutputPosition - ] + orderBy [desc $ sOutputs ^. ShieldOutputId] return sOutputs case r of Nothing -> return Nothing @@ -2889,10 +2898,7 @@ getOrchardActionAtBlock pool znet b = do txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) where_ (blks ^. ZcashBlockHeight <=. val b) where_ (blks ^. ZcashBlockNetwork ==. val znet) - orderBy - [ desc $ txs ^. ZcashTransactionId - , desc $ oActions ^. OrchActionPosition - ] + orderBy [desc $ oActions ^. OrchActionId] return oActions case r of Nothing -> return Nothing diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 9679539..ad5d5c7 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} module Zenith.GUI where @@ -10,9 +11,14 @@ import Codec.QRCode import Codec.QRCode.JuicyPixels import Control.Concurrent (threadDelay) import Control.Exception (throwIO, try) -import Control.Monad (unless, when) +import Control.Monad (forM_, unless, when) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT) +import Control.Monad.Logger + ( LoggingT + , logDebugN + , runNoLoggingT + , runStderrLoggingT + ) import Data.Aeson import qualified Data.ByteString as BS import Data.HexString (toText) @@ -38,12 +44,16 @@ import ZcashHaskell.Orchard , isValidUnifiedAddress , parseAddress ) -import ZcashHaskell.Transparent (encodeTransparentReceiver) +import ZcashHaskell.Transparent + ( decodeTransparentAddress + , encodeTransparentReceiver + ) import ZcashHaskell.Types ( BlockResponse(..) , Scope(..) , ToBytes(..) , UnifiedAddress(..) + , ValidAddress(..) , ZcashNet(..) , ZebraGetBlockChainInfo(..) , ZebraGetInfo(..) @@ -56,6 +66,7 @@ import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs) import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Utils ( displayAmount + , getChainTip , isRecipientValidGUI , isValidString , isZecAddressValid @@ -83,7 +94,7 @@ data AppEvent | SwitchAddr !Int | SwitchAcc !Int | SwitchWal !Int - | UpdateBalance !(Integer, Integer) + | UpdateBalance !(Integer, Integer, Integer, Integer) | CopyAddr !(Maybe (Entity WalletAddress)) | LoadTxs ![Entity UserTx] | LoadAddrs ![Entity WalletAddress] @@ -131,6 +142,10 @@ data AppEvent | CloseShield | ShowDeShield | CloseDeShield + | SendDeShield + | SendShield + | StartSync + | TreeSync deriving (Eq, Show) data AppModel = AppModel @@ -741,7 +756,7 @@ buildUI wenv model = widgetTree box (label (fromMaybe "?" $ model ^. modalMsg) `styleBasic` [textSize 12, textFont "Bold"]) `styleBasic` - [bgColor (white & L.a .~ 0.5)] + [bgColor (white & L.a .~ 0.7)] txOverlay = case model ^. showTx of Nothing -> alert CloseTx $ label "N/A" @@ -990,21 +1005,17 @@ buildUI wenv model = widgetTree [textFont "Bold", textSize 12]) , separatorLine `styleBasic` [fgColor btnColor] , spacer - , hstack - [ filler - , label ("Amount : ") `styleBasic` - [width 50, textFont "Bold"] - , spacer - , label (displayAmount (model ^. network) 100) `styleBasic` - [width 50, textFont "Bold"] - , filler - ] + , label + ("Shield " <> + displayAmount (model ^. network) (model ^. tBalance) <> + "?") `styleBasic` + [width 50, textFont "Regular"] , spacer , box_ [alignMiddle] (hstack [ filler - , mainButton "Proceed" NotImplemented `nodeEnabled` + , mainButton "Proceed" SendShield `nodeEnabled` True , spacer , mainButton "Cancel" CloseShield `nodeEnabled` @@ -1033,44 +1044,54 @@ buildUI wenv model = widgetTree [textFont "Bold", textSize 12]) , separatorLine `styleBasic` [fgColor btnColor] , spacer - , hstack - [ (label "Total Transparent : " `styleBasic` - [textFont "Bold"]) - , (label "0.00") - ] - , spacer - , hstack - [ (label "Total Shielded : " `styleBasic` - [textFont "Bold"]) - , (label "0.00") - ] - , spacer - , hstack - [ label "Amount:" `styleBasic` - [width 50, textFont "Bold"] - , spacer - , numericField_ - sendAmount - [ decimals 8 - , minValue 0.0 - , maxValue - (fromIntegral (model ^. sBalance) / - 100000000.0) - , validInput sBalanceValid - , onChange CheckAmount - ] `styleBasic` - [ width 150 - , styleIf - (not $ model ^. sBalanceValid) - (textColor red) - ] - ] + , box_ + [] + (vstack + [ hstack + [ label "Total Transparent : " `styleBasic` + [textFont "Bold"] + , label + (displayAmount + (model ^. network) + (model ^. tBalance)) + ] + , spacer + , hstack + [ label "Total Shielded : " `styleBasic` + [textFont "Bold"] + , label + (displayAmount + (model ^. network) + (model ^. sBalance)) + ] + , spacer + , hstack + [ label "Amount:" `styleBasic` + [width 50, textFont "Bold"] + , spacer + , numericField_ + sendAmount + [ decimals 8 + , minValue 0.0 + , maxValue + (fromIntegral (model ^. sBalance) / + 100000000.0) + , validInput sBalanceValid + , onChange CheckAmount + ] `styleBasic` + [ width 150 + , styleIf + (not $ model ^. sBalanceValid) + (textColor red) + ] + ] + ]) , spacer , box_ [alignMiddle] (hstack [ filler - , mainButton "Proceed" NotImplemented `nodeEnabled` + , mainButton "Proceed" SendDeShield `nodeEnabled` True , spacer , mainButton "Cancel" CloseDeShield `nodeEnabled` @@ -1085,23 +1106,6 @@ buildUI wenv model = widgetTree ]) `styleBasic` [bgColor (white & L.a .~ 0.5)] --- , spacer --- , numericField_ --- sendAmount --- [ decimals 8 --- , minValue 0.0 --- , maxValue --- (fromIntegral (model ^. tBalance) / 100000000.0) --- , validInput tBalanceValid --- , onChange CheckAmount --- ] `styleBasic` --- [ width 150 --- , styleIf --- (not $ model ^. tBalanceValid) --- (textColor red) --- ] --- (model ^. amountValid && model ^. recipientValid) --- (model ^. amountValid && model ^. recipientValid) notImplemented = NotImplemented generateQRCodes :: Config -> IO () @@ -1303,11 +1307,13 @@ handleEvent wenv node model evt = UpdateBalance <$> do dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration case selectAccount i of - Nothing -> return (0, 0) + Nothing -> return (0, 0, 0, 0) Just acc -> do b <- getBalance dbPool $ entityKey acc u <- getUnconfirmedBalance dbPool $ entityKey acc - return (b, u) + s <- getShieldedBalance dbPool $ entityKey acc + t <- getTransparentBalance dbPool $ entityKey acc + return (b, u, s, t) , Event $ SetPool OrchardPool ] SwitchWal i -> @@ -1319,9 +1325,9 @@ handleEvent wenv node model evt = Nothing -> return [] Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal ] - UpdateBalance (b, u) -> + UpdateBalance (b, u, s, t) -> [ Model $ - model & balance .~ b & unconfBalance .~ + model & balance .~ b & sBalance .~ s & tBalance .~ t & unconfBalance .~ (if u == 0 then Nothing else Just u) @@ -1371,7 +1377,7 @@ handleEvent wenv node model evt = else [Event $ NewAccount currentWallet] LoadWallets a -> if not (null a) - then [ Model $ model & wallets .~ a + then [ Model $ model & wallets .~ a & modalMsg .~ Nothing , Event $ SwitchWal $ model ^. selWallet ] else [Event NewWallet] @@ -1381,32 +1387,39 @@ handleEvent wenv node model evt = CloseTxId -> [Model $ model & showId .~ Nothing] ShowTx i -> [Model $ model & showTx ?~ i] TickUp -> - if (model ^. timer) < 90 - then [Model $ model & timer .~ (1 + model ^. timer)] - else if (model ^. barValue) == 1.0 - then [ Model $ model & timer .~ 0 & barValue .~ 0.0 - , Producer $ - scanZebra - (c_dbPath $ model ^. configuration) - (c_zebraHost $ model ^. configuration) - (c_zebraPort $ model ^. configuration) - (model ^. network) - ] - else [Model $ model & timer .~ 0] + if isNothing (model ^. modalMsg) + then if (model ^. timer) < 90 + then [Model $ model & timer .~ (1 + model ^. timer)] + else if (model ^. barValue) == 1.0 + then [ Model $ + model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~ + "Downloading blocks..." + , Producer $ + runStderrLoggingT . + scanZebra + (c_dbPath $ model ^. configuration) + (c_zebraHost $ model ^. configuration) + (c_zebraPort $ model ^. configuration) + (model ^. network) + ] + else [Model $ model & timer .~ 0] + else [Model $ model & timer .~ 0] + TreeSync -> [Model $ model & modalMsg ?~ "Updating commitment trees..."] + StartSync -> + [ Model $ model & modalMsg ?~ "Updating wallet..." + , Task $ do + case currentWallet of + Nothing -> return $ ShowError "No wallet available" + Just cW -> do + runStderrLoggingT $ syncWallet (model ^. configuration) cW + pool <- + runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + wL <- getWallets pool (model ^. network) + return $ LoadWallets wL + ] SyncVal i -> if (i + model ^. barValue) >= 0.999 - then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing - , Task $ do - case currentWallet of - Nothing -> return $ ShowError "No wallet available" - Just cW -> do - runStderrLoggingT $ syncWallet (model ^. configuration) cW - pool <- - runNoLoggingT $ - initPool $ c_dbPath $ model ^. configuration - wL <- getWallets pool (model ^. network) - return $ LoadWallets wL - ] + then [Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing] else [ Model $ model & barValue .~ validBarValue (i + model ^. barValue) & modalMsg ?~ @@ -1491,7 +1504,10 @@ handleEvent wenv node model evt = model & msgAB ?~ "Function not implemented..." & menuPopup .~ False ] CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] - ShowShield -> [Model $ model & shieldZec .~ True & menuPopup .~ False] + ShowShield -> + if model ^. tBalance > 0 + then [Model $ model & shieldZec .~ True & menuPopup .~ False] + else [Event $ ShowError "No transparent funds in this account"] CloseShield -> [Model $ model & shieldZec .~ False] ShowDeShield -> [Model $ model & deShieldZec .~ True & menuPopup .~ False] CloseDeShield -> [Model $ model & deShieldZec .~ False] @@ -1507,6 +1523,31 @@ handleEvent wenv node model evt = abList <- getAdrBook dbPool $ model ^. network return $ LoadAbList abList ] + SendDeShield -> + case currentAccount of + Nothing -> + [Event $ ShowError "No account available", Event CloseDeShield] + Just acc -> + [ Producer $ + deshieldTransaction + (model ^. configuration) + (model ^. network) + (entityKey acc) + currentAddress + (fromFloatDigits $ model ^. sendAmount) + , Event CloseDeShield + ] + SendShield -> + case currentAccount of + Nothing -> [Event $ ShowError "No account available", Event CloseShield] + Just acc -> + [ Producer $ + shieldTransaction + (model ^. configuration) + (model ^. network) + (entityKey acc) + , Event CloseShield + ] where currentWallet = if null (model ^. wallets) @@ -1621,43 +1662,57 @@ handleEvent wenv node model evt = res <- liftIO $ updateAdrsInAdrBook pool d a a return $ ShowMessage "Address Book entry updated!!" -scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO () +scanZebra :: + T.Text + -> T.Text + -> Int + -> ZcashNet + -> (AppEvent -> IO ()) + -> LoggingT IO () scanZebra dbPath zHost zPort net sendMsg = do bStatus <- liftIO $ checkBlockChain zHost zPort - pool <- runNoLoggingT $ initPool dbPath + pool <- liftIO $ runNoLoggingT $ initPool dbPath b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net - dbBlock <- getMaxBlock pool $ ZcashNetDB net - chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1 - syncChk <- isSyncing pool + dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB net + chkBlock <- liftIO $ checkIntegrity dbPath zHost zPort net dbBlock 1 + logDebugN $ "dbBlock: " <> T.pack (show dbBlock) + logDebugN $ "chkBlock: " <> T.pack (show chkBlock) + syncChk <- liftIO $ isSyncing pool if syncChk - then sendMsg (ShowError "Sync already in progress") + then liftIO $ sendMsg (ShowError "Sync already in progress") else do let sb = if chkBlock == dbBlock then max dbBlock b else max chkBlock b unless (chkBlock == dbBlock || chkBlock == 1) $ - runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net + rewindWalletData pool sb $ ZcashNetDB net if sb > zgb_blocks bStatus || sb < 1 - then sendMsg (ShowError "Invalid starting block for scan") + then liftIO $ sendMsg (ShowError "Invalid starting block for scan") else do let bList = [(sb + 1) .. (zgb_blocks bStatus)] if not (null bList) then do let step = (1.0 :: Float) / fromIntegral (length bList) - _ <- startSync pool - mapM_ (processBlock pool step) bList + _ <- liftIO $ startSync pool + mapM_ (liftIO . processBlock pool step) bList confUp <- - try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + liftIO $ try $ updateConfs zHost zPort pool :: LoggingT + IO + (Either IOError ()) case confUp of Left _e0 -> do - _ <- completeSync pool Failed - sendMsg - (ShowError "Failed to update unconfirmed transactions") + _ <- liftIO $ completeSync pool Failed + liftIO $ + sendMsg + (ShowError "Failed to update unconfirmed transactions") Right _ -> do - _ <- completeSync pool Successful - return () - else sendMsg (SyncVal 1.0) + liftIO $ sendMsg TreeSync + _ <- updateCommitmentTrees pool zHost zPort $ ZcashNetDB net + _ <- liftIO $ completeSync pool Successful + logDebugN "Starting wallet sync" + liftIO $ sendMsg StartSync + else liftIO $ sendMsg (SyncVal 1.0) where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do @@ -1697,6 +1752,83 @@ scanZebra dbPath zHost zPort net sendMsg = do mapM_ (processTx zHost zPort bi pool) $ bl_txs blk sendMsg (SyncVal step) +shieldTransaction :: + Config -> ZcashNet -> ZcashAccountId -> (AppEvent -> IO ()) -> IO () +shieldTransaction config znet accId sendMsg = do + sendMsg $ ShowModal "Shielding funds..." + let dbPath = c_dbPath config + let zHost = c_zebraHost config + let zPort = c_zebraPort config + pool <- runNoLoggingT $ initPool dbPath + bl <- getChainTip zHost zPort + res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl + forM_ res $ \case + Left e -> sendMsg $ ShowError $ T.pack (show e) + Right rawTx -> do + sendMsg $ ShowMsg "Transaction ready, sending to Zebra..." + resp <- + makeZebraCall + zHost + zPort + "sendrawtransaction" + [Data.Aeson.String $ toText rawTx] + case resp of + Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> T.pack (show e1) + Right txId -> sendMsg $ ShowTxId txId + +deshieldTransaction :: + Config + -> ZcashNet + -> ZcashAccountId + -> Maybe (Entity WalletAddress) + -> Scientific + -> (AppEvent -> IO ()) + -> IO () +deshieldTransaction config znet accId addR pnote sendMsg = do + case addR of + Nothing -> sendMsg $ ShowError "No address available" + Just addr -> do + sendMsg $ ShowModal "De-shielding funds..." + let dbPath = c_dbPath config + let zHost = c_zebraHost config + let zPort = c_zebraPort config + pool <- runNoLoggingT $ initPool dbPath + bl <- getChainTip zHost zPort + let tAddrMaybe = + Transparent <$> + ((decodeTransparentAddress . + E.encodeUtf8 . encodeTransparentReceiver znet) =<< + (t_rec =<< + (isValidUnifiedAddress . + E.encodeUtf8 . getUA . walletAddressUAddress) + (entityVal addr))) + case tAddrMaybe of + Nothing -> sendMsg $ ShowError "No transparent address available" + Just tAddr -> do + res <- + runStderrLoggingT $ + deshieldNotes + pool + zHost + zPort + znet + accId + bl + (ProposedNote (ValidAddressAPI tAddr) pnote Nothing) + case res of + Left e -> sendMsg $ ShowError $ T.pack (show e) + Right rawTx -> do + sendMsg $ ShowModal "Transaction ready, sending to Zebra..." + resp <- + makeZebraCall + zHost + zPort + "sendrawtransaction" + [Data.Aeson.String $ toText rawTx] + case resp of + Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1 + Right txId -> sendMsg $ ShowTxId txId + sendTransaction :: Config -> ZcashNet @@ -1815,6 +1947,14 @@ runZenithGUI config = do then getUnconfirmedBalance pool $ entityKey $ head accList else return 0 abList <- getAdrBook pool (zgb_net chainInfo) + shieldBal <- + if not (null accList) + then getShieldedBalance pool $ entityKey $ head accList + else return 0 + transBal <- + if not (null accList) + then getTransparentBalance pool $ entityKey $ head accList + else return 0 let model = AppModel config @@ -1874,9 +2014,9 @@ runZenithGUI config = do Full False False - 0 + transBal False - 0 + shieldBal False startApp model handleEvent buildUI (params hD) Left _e -> print "Zebra not available" diff --git a/test/Spec.hs b/test/Spec.hs index bb0729f..6b044fc 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -42,6 +42,7 @@ import ZcashHaskell.Sapling import ZcashHaskell.Transparent ( decodeExchangeAddress , decodeTransparentAddress + , encodeExchangeAddress ) import ZcashHaskell.Types ( DecodedNote(..) @@ -59,6 +60,7 @@ import ZcashHaskell.Types , Scope(..) , ShieldedOutput(..) , TxError(..) + , UnifiedAddress(..) , ValidAddress(..) , ZcashNet(..) ) @@ -623,23 +625,76 @@ main = do let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)] getNotePosition updatedTree 4 `shouldBe` Just 39734 it "Truncate tree" $ do + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" + maxBlock <- getMaxBlock pool $ ZcashNetDB TestNet + dbTree <- getOrchardTree pool + case dbTree of + Nothing -> assertFailure "failed to get tree from DB" + Just (oTree, oSync) -> do + let startBlock = oSync - 5 + zebraTreesIn <- + getCommitmentTrees + pool + "localhost" + 18232 + (ZcashNetDB TestNet) + startBlock + ix <- getOrchardActionAtBlock pool (ZcashNetDB TestNet) startBlock + case ix of + Nothing -> assertFailure "couldn't find index at block" + Just i -> do + updatedTree <- + runFileLoggingT "test.log" $ truncateTree oTree i + let finalAnchor = + getOrchardTreeAnchor $ + OrchardCommitmentTree $ ztiOrchard zebraTreesIn + getHash (value updatedTree) `shouldBe` finalAnchor + it "Counting leaves in 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 + countLeaves newTree `shouldBe` + fromIntegral (1 + getPosition (value newTree)) + it "Validate large load" $ do + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" + maxBlock <- getMaxBlock pool $ ZcashNetDB TestNet + let startBlock = maxBlock - 2000 + zebraTreesIn <- + getCommitmentTrees + pool + "localhost" + 18232 + (ZcashNetDB TestNet) + startBlock + zebraTreesOut <- + getCommitmentTrees + pool + "localhost" + 18232 + (ZcashNetDB TestNet) + maxBlock + case getOrchardTreeParts $ + OrchardCommitmentTree $ ztiOrchard zebraTreesIn of + Nothing -> assertFailure "Failed to get tree parts" + Just t1 -> do + let newTree = mkOrchardTree t1 + oAct <- getOrchardActions pool startBlock $ ZcashNetDB TestNet + let cmxs = + map + (\(_, y) -> + ( getHex $ orchActionCmx $ entityVal y + , fromSqlKey $ entityKey y)) + oAct + let updatedTree = foldl' append newTree cmxs + let finalAnchor = + getOrchardTreeAnchor $ + OrchardCommitmentTree $ ztiOrchard zebraTreesOut + getHash (value updatedTree) `shouldBe` finalAnchor it "Validate tree from DB" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" dbTree <- getOrchardTree pool @@ -657,6 +712,19 @@ main = do getOrchardTreeAnchor $ OrchardCommitmentTree $ ztiOrchard zebraTrees getHash (value oTree) `shouldBe` finalAnchor + describe "TEX address" $ do + it "from UA" $ do + let addr = + parseAddress + "utest1fqtne08sdgmae0g0un7j3h6ss9gafguprv0yvkxv4trxxsdxx467pxkkc98cpsyk5r2enwwpn3p5c6aw537wyvlz20hs7vcqc4uhm22yfjnrsm8hy2hjjrscvhk2ac32rzndu94hh28gdl62wqgy3yev7w0gj9lmmz6yasghmle6tllx4yjv9sjt0xml66y9lyxc4rkk6q425nc5gxa" + case addr of + Nothing -> assertFailure "failed to parse address" + Just (Unified ua) -> + case (encodeExchangeAddress (ua_net ua) =<< (t_rec ua)) of + Nothing -> assertFailure "failed to encode TEX" + Just tex -> + tex `shouldBe` "textest1jze8c9jxxrpct34tpe4pvquz8nvxsxt6gawqqf" + Just _ -> assertFailure "no transparent receiver" describe "Creating Tx" $ do describe "Full" $ do it "To Orchard" $ do