Milestone 2: Graphic User Interface #93
5 changed files with 86 additions and 25 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue