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 send a new transaction
|
||||||
- Dialog to display Tx ID after successful broadcast
|
- Dialog to display Tx ID after successful broadcast
|
||||||
- Unconfirmed balance display on TUI and GUI
|
- Unconfirmed balance display on TUI and GUI
|
||||||
|
- Tracking of unconfirmed notes
|
||||||
|
|
||||||
### Fixed
|
### Fixed
|
||||||
|
|
||||||
|
|
|
@ -89,7 +89,7 @@ import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
import Zenith.Scanner (processTx)
|
import Zenith.Scanner (processTx, updateConfs)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
|
@ -596,18 +596,26 @@ scanZebra dbP zHost zPort b eChan = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
pool <- runNoLoggingT $ initPool dbP
|
pool <- runNoLoggingT $ initPool dbP
|
||||||
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
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
|
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
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock pool step bl = do
|
processBlock pool step bl = do
|
||||||
|
|
|
@ -32,7 +32,6 @@ import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Database.Esqueleto.Experimental
|
import Database.Esqueleto.Experimental
|
||||||
import qualified Database.Persist as P
|
|
||||||
import qualified Database.Persist.Sqlite as PS
|
import qualified Database.Persist.Sqlite as PS
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import Haskoin.Transaction.Common
|
import Haskoin.Transaction.Common
|
||||||
|
@ -43,7 +42,6 @@ import Haskoin.Transaction.Common
|
||||||
)
|
)
|
||||||
import qualified Lens.Micro as ML ((&), (.~), (^.))
|
import qualified Lens.Micro as ML ((&), (.~), (^.))
|
||||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Sapling (decodeSaplingOutputEsk)
|
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( DecodedNote(..)
|
( DecodedNote(..)
|
||||||
, OrchardAction(..)
|
, OrchardAction(..)
|
||||||
|
@ -1626,6 +1624,27 @@ getWalletTxId pool wId = do
|
||||||
where_ (wtx ^. WalletTransactionId ==. val wId)
|
where_ (wtx ^. WalletTransactionId ==. val wId)
|
||||||
pure $ wtx ^. WalletTransactionTxId
|
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
|
-- | Helper function to extract a Unified Address from the database
|
||||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
readUnifiedAddressDB =
|
readUnifiedAddressDB =
|
||||||
|
|
|
@ -46,7 +46,7 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
import Zenith.GUI.Theme
|
import Zenith.GUI.Theme
|
||||||
import Zenith.Scanner (processTx)
|
import Zenith.Scanner (processTx, updateConfs)
|
||||||
import Zenith.Types hiding (ZcashAddress(..))
|
import Zenith.Types hiding (ZcashAddress(..))
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayAmount
|
( displayAmount
|
||||||
|
@ -1145,15 +1145,19 @@ scanZebra dbPath zHost zPort sendMsg = do
|
||||||
b <- liftIO $ getMinBirthdayHeight pool
|
b <- liftIO $ getMinBirthdayHeight pool
|
||||||
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
||||||
let sb = max dbBlock b
|
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
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock pool step bl = do
|
processBlock pool step bl = do
|
||||||
|
|
|
@ -33,7 +33,13 @@ import ZcashHaskell.Types
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||||
import Zenith.Core (checkBlockChain)
|
import Zenith.Core (checkBlockChain)
|
||||||
import Zenith.DB (getMaxBlock, initDb, saveTransaction)
|
import Zenith.DB
|
||||||
|
( getMaxBlock
|
||||||
|
, getUnconfirmedBlocks
|
||||||
|
, initDb
|
||||||
|
, saveConfs
|
||||||
|
, saveTransaction
|
||||||
|
)
|
||||||
import Zenith.Utils (jsonNumber)
|
import Zenith.Utils (jsonNumber)
|
||||||
|
|
||||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
-- | 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)
|
(fromRawSBundle $ zt_sBundle rzt)
|
||||||
(fromRawOBundle $ zt_oBundle rzt)
|
(fromRawOBundle $ zt_oBundle rzt)
|
||||||
return ()
|
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