Enhancements to blockchain scanner #74

Merged
pitmutt merged 2 commits from rav001 into dev041 2024-04-04 19:39:08 +00:00
4 changed files with 32 additions and 12 deletions
Showing only changes of commit 865f7241b1 - Show all commits

View file

@ -161,8 +161,7 @@ createWalletAddress n i zNet scope za = do
-- * Wallet -- * Wallet
-- | Sync the wallet with the data store -- | Sync the wallet with the data store
syncWallet :: syncWallet ::
T.Text -- ^ Wallet database T.Text -- ^ The database path
-> T.Text -- ^ Data store database
-> Entity ZcashWallet -> Entity ZcashWallet
-> IO () -> IO ()
syncWallet walletDb dataDb w = undefined syncWallet walletDb w = undefined

View file

@ -79,19 +79,21 @@ share
UniqueAddName accId name UniqueAddName accId name
deriving Show Eq deriving Show Eq
WalletTransaction WalletTransaction
addrId WalletAddressId
txId HexStringDB txId HexStringDB
block Int
conf Int conf Int
time Int time Int
deriving Show Eq deriving Show Eq
WalletTrNote WalletTrNote
tx WalletTransactionId tx WalletTransactionId
addrId WalletAddressId
value Int value Int
rawId TransparentNoteId rawId TransparentNoteId
spent Bool spent Bool
deriving Show Eq deriving Show Eq
WalletSapNote WalletSapNote
tx WalletTransactionId tx WalletTransactionId
addrId WalletAddressId
value Int value Int
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
@ -100,6 +102,7 @@ share
deriving Show Eq deriving Show Eq
WalletOrchNote WalletOrchNote
tx WalletTransactionId tx WalletTransactionId
addrId WalletAddressId
value Int value Int
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
@ -206,6 +209,18 @@ getMaxBlock dbPath = do
Nothing -> return $ -1 Nothing -> return $ -1
Just x -> return $ zcashTransactionBlock $ entityVal x Just x -> return $ zcashTransactionBlock $ entityVal x
-- | Returns the largest block in the wallet
getMaxWalletBlock ::
T.Text -- ^ The database path
-> IO Int
getMaxWalletBlock dbPath = do
b <-
runSqlite dbPath $
selectFirst [WalletTransactionBlock >. 0] [Desc WalletTransactionBlock]
case b of
Nothing -> return $ -1
Just x -> return $ walletTransactionBlock $ entityVal x
-- | Returns a list of addresses associated with the given account -- | Returns a list of addresses associated with the given account
getAddresses :: getAddresses ::
T.Text -- ^ The database path T.Text -- ^ The database path

View file

@ -8,6 +8,7 @@ import Data.HexString
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Utils.Monad (concatMapM) import GHC.Utils.Monad (concatMapM)
import System.Console.AsciiProgress
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
, RawZebraTx(..) , RawZebraTx(..)
@ -39,13 +40,15 @@ scanZebra b host port dbFilePath = do
Left e -> print e Left e -> print e
Right bStatus -> do Right bStatus -> do
dbBlock <- getMaxBlock dbFilePath dbBlock <- getMaxBlock dbFilePath
let sb = min dbBlock b let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then throwIO $ userError "Invalid starting block for scan" then throwIO $ userError "Invalid starting block for scan"
else do else do
let bList = [sb .. (zgb_blocks bStatus)] let bList = [sb .. (zgb_blocks bStatus)]
displayConsoleRegions $ do
pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
txList <- txList <-
try $ mapM_ (processBlock host port dbFilePath) bList :: IO try $ mapM_ (processBlock host port dbFilePath pg) bList :: IO
(Either IOError ()) (Either IOError ())
case txList of case txList of
Left e1 -> print e1 Left e1 -> print e1
@ -56,9 +59,10 @@ processBlock ::
T.Text -- ^ Host name for `zebrad` T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> T.Text -- ^ DB file path -> T.Text -- ^ DB file path
-> ProgressBar -- ^ Progress bar
-> Int -- ^ The block number to process -> Int -- ^ The block number to process
-> IO () -> IO ()
processBlock host port dbFp b = do processBlock host port dbFp pg b = do
r <- r <-
makeZebraCall makeZebraCall
host host
@ -80,6 +84,7 @@ processBlock host port dbFp b = do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime dbFp) $ mapM_ (processTx host port blockTime dbFp) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
tick pg
where where
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t = addTime bl t =

View file

@ -65,6 +65,7 @@ library
, vector , vector
, vty , vty
, word-wrap , word-wrap
, ascii-progress
, zcash-haskell , zcash-haskell
--pkgconfig-depends: rustzcash_wrapper --pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010