Implement unconfirmed note tracking

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
 

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
+  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
-  if sb > zgb_blocks bStatus || sb < 1
+  case confUp of
-    then do
+    Left _e0 ->
-      liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
+      liftIO $
-    else do
+      BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
-      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+    Right _ -> do
-      if not (null bList)
+      let sb = max dbBlock b
+      if sb > zgb_blocks bStatus || sb < 1
         then do
-          let step =
+          liftIO $
-                (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
+            BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
-          mapM_ (processBlock pool step) bList
+        else do
-        else liftIO $ BC.writeBChan eChan $ TickVal 1.0
+          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

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 =

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
+  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
-    then sendMsg (ShowError "Invalid starting block for scan")
+  case confUp of
-    else do
+    Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
-      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+    Right _ -> do
-      if not (null bList)
+      if sb > zgb_blocks bStatus || sb < 1
-        then do
+        then sendMsg (ShowError "Invalid starting block for scan")
-          let step = (1.0 :: Float) / fromIntegral (length bList)
+        else do
-          mapM_ (processBlock pool step) bList
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-        else sendMsg (SyncVal 1.0)
+          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

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