diff --git a/CHANGELOG.md b/CHANGELOG.md index da18fe5..ca58dc4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Dialog to send a new transaction - Dialog to display Tx ID after successful broadcast - Unconfirmed balance display on TUI and GUI +- Tracking of unconfirmed notes ### Fixed diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index db50c01..a1ef217 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -89,7 +89,7 @@ import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB -import Zenith.Scanner (processTx) +import Zenith.Scanner (processTx, updateConfs) import Zenith.Types ( Config(..) , PhraseDB(..) @@ -596,18 +596,26 @@ scanZebra dbP zHost zPort b eChan = do bStatus <- liftIO $ checkBlockChain zHost zPort pool <- runNoLoggingT $ initPool dbP dbBlock <- runNoLoggingT $ getMaxBlock pool - let sb = max dbBlock b - if sb > zgb_blocks bStatus || sb < 1 - then do - liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" - else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - if not (null bList) + confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + case confUp of + Left _e0 -> + liftIO $ + BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" + Right _ -> do + let sb = max dbBlock b + if sb > zgb_blocks bStatus || sb < 1 then do - let step = - (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) - mapM_ (processBlock pool step) bList - else liftIO $ BC.writeBChan eChan $ TickVal 1.0 + 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)) + mapM_ (processBlock pool step) bList + else liftIO $ BC.writeBChan eChan $ TickVal 1.0 where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index f855f02..6a7909a 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -32,7 +32,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Word import Database.Esqueleto.Experimental -import qualified Database.Persist as P import qualified Database.Persist.Sqlite as PS import Database.Persist.TH import Haskoin.Transaction.Common @@ -43,7 +42,6 @@ import Haskoin.Transaction.Common ) import qualified Lens.Micro as ML ((&), (.~), (^.)) import ZcashHaskell.Orchard (isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingOutputEsk) import ZcashHaskell.Types ( DecodedNote(..) , OrchardAction(..) @@ -1626,6 +1624,27 @@ getWalletTxId pool wId = do where_ (wtx ^. WalletTransactionId ==. val wId) pure $ wtx ^. WalletTransactionTxId +getUnconfirmedBlocks :: ConnectionPool -> IO [Int] +getUnconfirmedBlocks pool = do + r <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + wtx <- from $ table @WalletTransaction + where_ (wtx ^. WalletTransactionConf <=. val 10) + pure $ wtx ^. WalletTransactionBlock + return $ map (\(Value i) -> i) r + +saveConfs :: ConnectionPool -> Int -> Int -> IO () +saveConfs pool b c = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + update $ \t -> do + set t [WalletTransactionConf =. val c] + where_ $ t ^. WalletTransactionBlock ==. val b + -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB = diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 9430c34..fee2025 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -46,7 +46,7 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB import Zenith.GUI.Theme -import Zenith.Scanner (processTx) +import Zenith.Scanner (processTx, updateConfs) import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Utils ( displayAmount @@ -1145,15 +1145,19 @@ scanZebra dbPath zHost zPort sendMsg = do b <- liftIO $ getMinBirthdayHeight pool dbBlock <- runNoLoggingT $ getMaxBlock pool let sb = max dbBlock 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) - 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 _ -> do + 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) + mapM_ (processBlock pool step) bList + else sendMsg (SyncVal 1.0) where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index df47ed1..09f7ccc 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -33,7 +33,13 @@ import ZcashHaskell.Types ) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import Zenith.Core (checkBlockChain) -import Zenith.DB (getMaxBlock, initDb, saveTransaction) +import Zenith.DB + ( getMaxBlock + , getUnconfirmedBlocks + , initDb + , saveConfs + , saveTransaction + ) import Zenith.Utils (jsonNumber) -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database @@ -155,3 +161,26 @@ processTx host port bt pool t = do (fromRawSBundle $ zt_sBundle rzt) (fromRawOBundle $ zt_oBundle rzt) return () + +-- | Function to update unconfirmed transactions +updateConfs :: + T.Text -- ^ Host name for `zebrad` + -> Int -- ^ Port for `zebrad` + -> ConnectionPool + -> IO () +updateConfs host port pool = do + targetBlocks <- getUnconfirmedBlocks pool + mapM_ updateTx targetBlocks + where + updateTx :: Int -> IO () + updateTx b = do + r <- + makeZebraCall + host + port + "getblock" + [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] + case r of + Left e -> throwIO $ userError e + Right blk -> do + saveConfs pool b $ fromInteger $ bl_confirmations blk