From c75316ddd7cbeabf888a64bbfaa3ccc5e6e9332f Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Tue, 8 Oct 2024 08:20:52 -0500 Subject: [PATCH] feat(rpc): background wallet sync --- CHANGELOG.md | 2 + app/Server.hs | 17 +- src/Zenith/CLI.hs | 72 +++++--- src/Zenith/DB.hs | 47 +++++ src/Zenith/GUI.hs | 54 +++--- src/Zenith/RPC.hs | 403 ++++++++++++++++++++++++++++-------------- src/Zenith/Scanner.hs | 23 ++- 7 files changed, 430 insertions(+), 188 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a58632b..2d019ed 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - `getnewaccount` RPC method - `getnewaddress` RPC method - `getoperationstatus` RPC method + - `sendmany` RPC method - Function `prepareTxV2` implementing `PrivacyPolicy` ### Changed @@ -27,6 +28,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Detection of changes in database schema for automatic re-scan - Block tracking for chain re-org detection - Refactored `ZcashPool` +- Preventing write operations to occur during wallet sync ## [0.6.0.0-beta] diff --git a/app/Server.hs b/app/Server.hs index ea64684..feee0d7 100644 --- a/app/Server.hs +++ b/app/Server.hs @@ -2,15 +2,22 @@ module Server where +import Control.Concurrent (forkIO, threadDelay) import Control.Exception (throwIO, try) -import Control.Monad (when) +import Control.Monad (forever, when) import Data.Configurator import Network.Wai.Handler.Warp (run) import Servant import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..)) import Zenith.Core (checkBlockChain, checkZebra) import Zenith.DB (initDb) -import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer) +import Zenith.RPC + ( State(..) + , ZenithRPC(..) + , authenticate + , scanZebra + , zenithServer + ) import Zenith.Scanner (rescanZebra) import Zenith.Types (Config(..)) @@ -39,6 +46,12 @@ main = do Left e2 -> throwIO $ userError e2 Right x' -> do when x' $ rescanZebra zebraHost zebraPort dbFilePath + _ <- + forkIO $ + forever $ do + _ <- + scanZebra dbFilePath zebraHost zebraPort (zgb_net chainInfo) + threadDelay 90000000 let myState = State (zgb_net chainInfo) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index f18493a..41994e8 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -102,6 +102,7 @@ import Zenith.Types , PrivacyPolicy(..) , UnifiedAddressDB(..) , ZcashNetDB(..) + , ZenithStatus(..) ) import Zenith.Utils ( displayTaz @@ -752,34 +753,45 @@ scanZebra dbP zHost zPort b eChan znet = do pool <- liftIO $ runNoLoggingT $ initPool dbP dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1 - logDebugN $ - "dbBlock: " <> - T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) - when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock - let sb = - if chkBlock == dbBlock - then max dbBlock b - else max chkBlock b - if sb > zgb_blocks bStatus || sb < 1 - then do - liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" + syncChk <- liftIO $ isSyncing pool + if syncChk + then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress" else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - if not (null bList) + logDebugN $ + "dbBlock: " <> + T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) + when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock + let sb = + if chkBlock == dbBlock + then max dbBlock b + else max chkBlock b + if sb > zgb_blocks bStatus || sb < 1 then do - let step = - (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) - mapM_ (liftIO . processBlock pool step) bList - else liftIO $ BC.writeBChan eChan $ TickVal 1.0 - confUp <- - liftIO $ try $ updateConfs zHost zPort pool :: LoggingT - IO - (Either IOError ()) - case confUp of - Left _e0 -> - liftIO $ - BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" - Right _ -> return () + liftIO $ + BC.writeBChan eChan $ TickMsg "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 (zgb_blocks bStatus - (sb + 1)) + _ <- liftIO $ startSync pool + mapM_ (liftIO . processBlock pool step) bList + confUp <- + liftIO $ try $ updateConfs zHost zPort pool :: LoggingT + IO + (Either IOError ()) + case confUp of + Left _e0 -> do + _ <- liftIO $ completeSync pool Failed + liftIO $ + BC.writeBChan eChan $ + TickMsg "Failed to update unconfirmed transactions" + Right _ -> do + _ <- liftIO $ completeSync pool Successful + return () + else liftIO $ BC.writeBChan eChan $ TickVal 1.0 where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do @@ -791,7 +803,9 @@ scanZebra dbP zHost zPort b eChan znet = do "getblock" [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] case r of - Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1 + Left e1 -> do + _ <- liftIO $ completeSync pool Failed + liftIO $ BC.writeBChan eChan $ TickMsg e1 Right blk -> do r2 <- liftIO $ @@ -801,7 +815,9 @@ scanZebra dbP zHost zPort b eChan znet = do "getblock" [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] case r2 of - Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 + Left e2 -> do + _ <- liftIO $ completeSync pool Failed + liftIO $ BC.writeBChan eChan $ TickMsg e2 Right hb -> do let blockTime = getBlockTime hb bi <- diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 79eb3eb..38bf062 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -291,6 +291,13 @@ share result T.Text Maybe UniqueOp uuid deriving Show Eq + ChainSync + name T.Text + start UTCTime + end UTCTime Maybe + status ZenithStatus + UniqueSync name + deriving Show Eq |] -- ** Type conversions @@ -2329,6 +2336,46 @@ finalizeOperation pool op status result = do ] where_ (ops ^. OperationId ==. val op) +-- * Chain sync +-- | Check if the wallet is currently running a sync +isSyncing :: ConnectionPool -> IO Bool +isSyncing pool = do + s <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ + selectOne $ do + r <- from $ table @ChainSync + where_ $ r ^. ChainSyncStatus ==. val Processing + pure r + case s of + Nothing -> return False + Just _ -> return True + +-- | Record the start of a sync +startSync :: ConnectionPool -> IO () +startSync pool = do + start <- getCurrentTime + _ <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ + upsert (ChainSync "Internal" start Nothing Processing) [] + return () + +-- | Complete a sync +completeSync :: ConnectionPool -> ZenithStatus -> IO () +completeSync pool st = do + end <- getCurrentTime + _ <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ + update $ \s -> do + set s [ChainSyncEnd =. val (Just end), ChainSyncStatus =. val st] + where_ (s ^. ChainSyncName ==. val "Internal") + return () + -- | Rewind the data store to a given block height rewindWalletData :: ConnectionPool -> Int -> IO () rewindWalletData pool b = do diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 71d8009..1b7a108 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -1475,7 +1475,6 @@ handleEvent wenv node model evt = res <- liftIO $ updateAdrsInAdrBook pool d a a return $ ShowMessage "Address Book entry updated!!" --- model & recipientValid .~ ((model ^. privacyChoice) == Low) ] scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO () scanZebra dbPath zHost zPort net sendMsg = do bStatus <- liftIO $ checkBlockChain zHost zPort @@ -1483,24 +1482,35 @@ scanZebra dbPath zHost zPort net sendMsg = do b <- liftIO $ getMinBirthdayHeight pool dbBlock <- getMaxBlock pool $ ZcashNetDB net chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 - unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock - let sb = - if chkBlock == dbBlock - then max dbBlock b - else max chkBlock b - if sb > zgb_blocks bStatus || sb < 1 - then sendMsg (ShowError "Invalid starting block for scan") + syncChk <- isSyncing pool + if syncChk + then sendMsg (ShowError "Sync already in progress") else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - if not (null bList) - then do - let step = (1.0 :: Float) / fromIntegral (length bList) - mapM_ (processBlock pool step) bList - else sendMsg (SyncVal 1.0) - confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) - case confUp of - Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions") - Right _ -> return () + unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock + let sb = + if chkBlock == dbBlock + then max dbBlock b + else max chkBlock b + if sb > zgb_blocks bStatus || sb < 1 + then 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 + confUp <- + try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + case confUp of + Left _e0 -> do + _ <- completeSync pool Failed + sendMsg + (ShowError "Failed to update unconfirmed transactions") + Right _ -> do + _ <- completeSync pool Successful + return () + else sendMsg (SyncVal 1.0) where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do @@ -1512,7 +1522,9 @@ scanZebra dbPath zHost zPort net sendMsg = do "getblock" [Data.Aeson.String $ showt bl, jsonNumber 1] case r of - Left e1 -> sendMsg (ShowError $ showt e1) + Left e1 -> do + _ <- completeSync pool Failed + sendMsg (ShowError $ showt e1) Right blk -> do r2 <- liftIO $ @@ -1522,7 +1534,9 @@ scanZebra dbPath zHost zPort net sendMsg = do "getblock" [Data.Aeson.String $ showt bl, jsonNumber 0] case r2 of - Left e2 -> sendMsg (ShowError $ showt e2) + Left e2 -> do + _ <- completeSync pool Failed + sendMsg (ShowError $ showt e2) Right hb -> do let blockTime = getBlockTime hb bi <- diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index cd8e5a0..fccdb3a 100644 --- a/src/Zenith/RPC.hs +++ b/src/Zenith/RPC.hs @@ -14,8 +14,9 @@ module Zenith.RPC where import Control.Concurrent (forkIO) import Control.Exception (try) +import Control.Monad (unless, when) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) +import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT) import Data.Aeson import qualified Data.HexString as H import Data.Int @@ -27,7 +28,8 @@ import qualified Data.UUID as U import Data.UUID.V4 (nextRandom) import qualified Data.Vector as V import Database.Esqueleto.Experimental - ( entityKey + ( ConnectionPool + , entityKey , entityVal , fromSqlKey , toSqlKey @@ -36,13 +38,27 @@ import Servant import Text.Read (readMaybe) import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Orchard (parseAddress) -import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..)) -import ZcashHaskell.Utils (makeZebraCall) -import Zenith.Core (createCustomWalletAddress, createZcashAccount, prepareTxV2) +import ZcashHaskell.Types + ( BlockResponse(..) + , RpcError(..) + , Scope(..) + , ZcashNet(..) + , ZebraGetBlockChainInfo(..) + ) +import ZcashHaskell.Utils (getBlockTime, makeZebraCall) +import Zenith.Core + ( checkBlockChain + , createCustomWalletAddress + , createZcashAccount + , prepareTxV2 + , syncWallet + ) import Zenith.DB ( Operation(..) , ZcashAccount(..) + , ZcashBlock(..) , ZcashWallet(..) + , completeSync , finalizeOperation , findNotesByAddress , getAccountById @@ -53,24 +69,32 @@ import Zenith.DB , getLastSyncBlock , getMaxAccount , getMaxAddress + , getMaxBlock + , getMinBirthdayHeight , getOperation , getPoolBalance , getUnconfPoolBalance , getWalletNotes , getWallets , initPool + , isSyncing + , rewindWalletData , saveAccount , saveAddress + , saveBlock , saveOperation , saveWallet + , startSync , toZcashAccountAPI , toZcashAddressAPI , toZcashWalletAPI , walletExists ) +import Zenith.Scanner (checkIntegrity, processTx, updateConfs) import Zenith.Types ( AccountBalance(..) , Config(..) + , HexStringDB(..) , PhraseDB(..) , PrivacyPolicy(..) , ProposedNote(..) @@ -622,27 +646,35 @@ zenithServer state = getinfo :<|> handleRPC case parameters req of NameParams t -> do let dbPath = w_dbPath state - sP <- liftIO generateWalletSeedPhrase pool <- liftIO $ runNoLoggingT $ initPool dbPath - r <- - liftIO $ - saveWallet pool $ - ZcashWallet - t - (ZcashNetDB $ w_network state) - (PhraseDB sP) - (w_startBlock state) - 0 - case r of - Nothing -> - return $ - ErrorResponse - (callId req) - (-32007) - "Entity with that name already exists." - Just r' -> - return $ - NewItemResponse (callId req) $ fromSqlKey $ entityKey r' + syncChk <- liftIO $ isSyncing pool + if syncChk + then return $ + ErrorResponse + (callId req) + (-32012) + "The Zenith server is syncing, please try again later." + else do + sP <- liftIO generateWalletSeedPhrase + r <- + liftIO $ + saveWallet pool $ + ZcashWallet + t + (ZcashNetDB $ w_network state) + (PhraseDB sP) + (w_startBlock state) + 0 + case r of + Nothing -> + return $ + ErrorResponse + (callId req) + (-32007) + "Entity with that name already exists." + Just r' -> + return $ + NewItemResponse (callId req) $ fromSqlKey $ entityKey r' _anyOtherParams -> return $ ErrorResponse (callId req) (-32602) "Invalid params" GetNewAccount -> @@ -650,34 +682,45 @@ zenithServer state = getinfo :<|> handleRPC NameIdParams t i -> do let dbPath = w_dbPath state pool <- liftIO $ runNoLoggingT $ initPool dbPath - w <- liftIO $ walletExists pool i - case w of - Just w' -> do - aIdx <- liftIO $ getMaxAccount pool $ entityKey w' - nAcc <- - liftIO - (try $ createZcashAccount t (aIdx + 1) w' :: IO - (Either IOError ZcashAccount)) - case nAcc of - Left e -> + syncChk <- liftIO $ isSyncing pool + if syncChk + then return $ + ErrorResponse + (callId req) + (-32012) + "The Zenith server is syncing, please try again later." + else do + w <- liftIO $ walletExists pool i + case w of + Just w' -> do + aIdx <- liftIO $ getMaxAccount pool $ entityKey w' + nAcc <- + liftIO + (try $ createZcashAccount t (aIdx + 1) w' :: IO + (Either IOError ZcashAccount)) + case nAcc of + Left e -> + return $ + ErrorResponse (callId req) (-32010) $ T.pack $ show e + Right nAcc' -> do + r <- liftIO $ saveAccount pool nAcc' + case r of + Nothing -> + return $ + ErrorResponse + (callId req) + (-32007) + "Entity with that name already exists." + Just x -> + return $ + NewItemResponse (callId req) $ + fromSqlKey $ entityKey x + Nothing -> return $ - ErrorResponse (callId req) (-32010) $ T.pack $ show e - Right nAcc' -> do - r <- liftIO $ saveAccount pool nAcc' - case r of - Nothing -> - return $ - ErrorResponse - (callId req) - (-32007) - "Entity with that name already exists." - Just x -> - return $ - NewItemResponse (callId req) $ - fromSqlKey $ entityKey x - Nothing -> - return $ - ErrorResponse (callId req) (-32008) "Wallet does not exist." + ErrorResponse + (callId req) + (-32008) + "Wallet does not exist." _anyOtherParams -> return $ ErrorResponse (callId req) (-32602) "Invalid params" GetNewAddress -> @@ -686,35 +729,49 @@ zenithServer state = getinfo :<|> handleRPC let dbPath = w_dbPath state let net = w_network state pool <- liftIO $ runNoLoggingT $ initPool dbPath - acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i - case acc of - Just acc' -> do - maxAddr <- - liftIO $ getMaxAddress pool (entityKey acc') External - newAddr <- - liftIO $ - createCustomWalletAddress - n - (maxAddr + 1) - net - External - acc' - s - t - dbAddr <- liftIO $ saveAddress pool newAddr - case dbAddr of - Just nAddr -> do - return $ - NewAddrResponse (callId req) (toZcashAddressAPI nAddr) + syncChk <- liftIO $ isSyncing pool + if syncChk + then return $ + ErrorResponse + (callId req) + (-32012) + "The Zenith server is syncing, please try again later." + else do + acc <- + liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i + case acc of + Just acc' -> do + maxAddr <- + liftIO $ getMaxAddress pool (entityKey acc') External + newAddr <- + liftIO $ + createCustomWalletAddress + n + (maxAddr + 1) + net + External + acc' + s + t + dbAddr <- liftIO $ saveAddress pool newAddr + case dbAddr of + Just nAddr -> do + return $ + NewAddrResponse + (callId req) + (toZcashAddressAPI nAddr) + Nothing -> + return $ + ErrorResponse + (callId req) + (-32007) + "Entity with that name already exists." Nothing -> return $ ErrorResponse (callId req) - (-32007) - "Entity with that name already exists." - Nothing -> - return $ - ErrorResponse (callId req) (-32006) "Account does not exist." + (-32006) + "Account does not exist." _anyOtherParams -> return $ ErrorResponse (callId req) (-32602) "Invalid params" GetOperationStatus -> @@ -739,65 +796,79 @@ zenithServer state = getinfo :<|> handleRPC let zPort = w_port state let znet = w_network state pool <- liftIO $ runNoLoggingT $ initPool dbPath - opid <- liftIO nextRandom - startTime <- liftIO getCurrentTime - opkey <- - liftIO $ - saveOperation pool $ - Operation (ZenithUuid opid) startTime Nothing Processing Nothing - case opkey of - Nothing -> - return $ ErrorResponse (callId req) (-32010) "Internal Error" - Just opkey' -> do - acc <- - liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a - case acc of - Just acc' -> do - bl <- - liftIO $ - getLastSyncBlock - pool - (zcashAccountWalletId $ entityVal acc') - _ <- - liftIO $ - forkIO $ do - res <- - liftIO $ - runNoLoggingT $ - prepareTxV2 - pool - zHost - zPort - znet - (entityKey acc') - bl - ns - p - case res of - Left e -> - finalizeOperation pool opkey' Failed $ - T.pack $ show e - Right rawTx -> do - zebraRes <- - makeZebraCall - zHost - zPort - "sendrawtransaction" - [Data.Aeson.String $ H.toText rawTx] - case zebraRes of - Left e1 -> - finalizeOperation pool opkey' Failed $ - T.pack $ show e1 - Right txId -> - finalizeOperation pool opkey' Successful $ - "Tx ID: " <> H.toText txId - return $ SendResponse (callId req) opid + syncChk <- liftIO $ isSyncing pool + if syncChk + then return $ + ErrorResponse + (callId req) + (-32012) + "The Zenith server is syncing, please try again later." + else do + opid <- liftIO nextRandom + startTime <- liftIO getCurrentTime + opkey <- + liftIO $ + saveOperation pool $ + Operation + (ZenithUuid opid) + startTime + Nothing + Processing + Nothing + case opkey of Nothing -> return $ - ErrorResponse - (callId req) - (-32006) - "Account does not exist." + ErrorResponse (callId req) (-32010) "Internal Error" + Just opkey' -> do + acc <- + liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a + case acc of + Just acc' -> do + bl <- + liftIO $ + getLastSyncBlock + pool + (zcashAccountWalletId $ entityVal acc') + _ <- + liftIO $ + forkIO $ do + res <- + liftIO $ + runNoLoggingT $ + prepareTxV2 + pool + zHost + zPort + znet + (entityKey acc') + bl + ns + p + case res of + Left e -> + finalizeOperation pool opkey' Failed $ + T.pack $ show e + Right rawTx -> do + zebraRes <- + makeZebraCall + zHost + zPort + "sendrawtransaction" + [Data.Aeson.String $ H.toText rawTx] + case zebraRes of + Left e1 -> + finalizeOperation pool opkey' Failed $ + T.pack $ show e1 + Right txId -> + finalizeOperation pool opkey' Successful $ + "Tx ID: " <> H.toText txId + return $ SendResponse (callId req) opid + Nothing -> + return $ + ErrorResponse + (callId req) + (-32006) + "Account does not exist." _anyOtherParams -> return $ ErrorResponse (callId req) (-32602) "Invalid params" @@ -812,3 +883,67 @@ authenticate config = BasicAuthCheck check packRpcResponse :: ToJSON a => T.Text -> a -> Value packRpcResponse i x = object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x] + +scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO () +scanZebra dbPath zHost zPort net = do + bStatus <- checkBlockChain zHost zPort + pool <- runNoLoggingT $ initPool dbPath + b <- getMinBirthdayHeight pool + dbBlock <- getMaxBlock pool $ ZcashNetDB net + chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 + syncChk <- isSyncing pool + unless syncChk $ do + unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock + let sb = + if chkBlock == dbBlock + then max dbBlock b + else max chkBlock b + unless (sb > zgb_blocks bStatus || sb < 1) $ do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + unless (null bList) $ do + _ <- startSync pool + mapM_ (processBlock pool) bList + confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + case confUp of + Left _e0 -> do + _ <- completeSync pool Failed + return () + Right _ -> do + wals <- getWallets pool net + runStderrLoggingT $ + mapM_ + (syncWallet (Config dbPath zHost zPort "user" "pwd" 8080)) + wals + _ <- completeSync pool Successful + return () + where + processBlock :: ConnectionPool -> Int -> IO () + processBlock pool bl = do + r <- + makeZebraCall + zHost + zPort + "getblock" + [Data.Aeson.String $ T.pack (show bl), jsonNumber 1] + case r of + Left _ -> completeSync pool Failed + Right blk -> do + r2 <- + makeZebraCall + zHost + zPort + "getblock" + [Data.Aeson.String $ T.pack (show bl), jsonNumber 0] + case r2 of + Left _ -> completeSync pool Failed + Right hb -> do + let blockTime = getBlockTime hb + bi <- + saveBlock pool $ + ZcashBlock + (fromIntegral $ bl_height blk) + (HexStringDB $ bl_hash blk) + (fromIntegral $ bl_confirmations blk) + blockTime + (ZcashNetDB net) + mapM_ (processTx zHost zPort bi pool) $ bl_txs blk diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index e6241b0..c556d88 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -37,6 +37,7 @@ import Zenith.DB , ZcashBlockId , clearWalletData , clearWalletTransactions + , completeSync , getBlock , getMaxBlock , getMinBirthdayHeight @@ -47,10 +48,16 @@ import Zenith.DB , saveBlock , saveConfs , saveTransaction + , startSync , updateWalletSync , upgradeQrTable ) -import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..)) +import Zenith.Types + ( Config(..) + , HexStringDB(..) + , ZcashNetDB(..) + , ZenithStatus(..) + ) import Zenith.Utils (jsonNumber) -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database @@ -74,6 +81,7 @@ rescanZebra host port dbFilePath = do upgradeQrTable pool1 clearWalletTransactions pool1 clearWalletData pool1 + _ <- startSync pool1 dbBlock <- getMaxBlock pool1 znet b <- liftIO $ getMinBirthdayHeight pool1 let sb = max dbBlock b @@ -99,6 +107,7 @@ rescanZebra host port dbFilePath = do {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-} {-mapM_ (processBlock host port pool3 pg3 znet) bl3-} print "Please wait..." + _ <- completeSync pool1 Successful print "Rescan complete" -- | Function to process a raw block and extract the transaction information @@ -119,7 +128,9 @@ processBlock host port pool pg net b = do "getblock" [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] case r of - Left e -> liftIO $ throwIO $ userError e + Left e -> do + _ <- completeSync pool Failed + liftIO $ throwIO $ userError e Right blk -> do r2 <- liftIO $ @@ -129,7 +140,9 @@ processBlock host port pool pg net b = do "getblock" [Data.Aeson.String $ T.pack $ show b, jsonNumber 0] case r2 of - Left e2 -> liftIO $ throwIO $ userError e2 + Left e2 -> do + _ <- completeSync pool Failed + liftIO $ throwIO $ userError e2 Right hb -> do let blockTime = getBlockTime hb bi <- @@ -160,7 +173,9 @@ processTx host port bt pool t = do "getrawtransaction" [Data.Aeson.String $ toText t, jsonNumber 1] case r of - Left e -> liftIO $ throwIO $ userError e + Left e -> do + _ <- completeSync pool Failed + liftIO $ throwIO $ userError e Right rawTx -> do case readZebraTransaction (ztr_hex rawTx) of Nothing -> return ()