RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
5 changed files with 29 additions and 17 deletions
Showing only changes of commit c68c504b53 - Show all commits

View file

@ -717,10 +717,10 @@ abMBarAttr = A.attrName "menubar"
scanZebra :: scanZebra ::
T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO () T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
scanZebra dbP zHost zPort b eChan net = do scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP pool <- runNoLoggingT $ initPool dbP
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- getMaxBlock pool $ ZcashNetDB znet
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of case confUp of
Left _e0 -> Left _e0 ->
@ -765,7 +765,7 @@ scanZebra dbP zHost zPort b eChan net = do
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $ mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ BC.writeBChan eChan $ TickVal step liftIO $ BC.writeBChan eChan $ TickVal step
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse

View file

@ -237,7 +237,7 @@ findSaplingOutputs config b znet za = do
let zebraPort = c_zebraPort config let zebraPort = c_zebraPort config
let zn = getNet znet let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
tList <- getShieldedOutputs pool b tList <- getShieldedOutputs pool b znet
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
decryptNotes sT zn pool tList decryptNotes sT zn pool tList
@ -328,7 +328,7 @@ findOrchardActions config b znet za = do
let zebraPort = c_zebraPort config let zebraPort = c_zebraPort config
let zn = getNet znet let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b tList <- getOrchardActions pool b znet
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees let sT = OrchardCommitmentTree $ ztiOrchard trees
decryptNotes sT zn pool tList decryptNotes sT zn pool tList
@ -700,19 +700,20 @@ syncWallet ::
syncWallet config w = do syncWallet config w = do
startTime <- liftIO getCurrentTime startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config let walletDb = c_dbPath config
let znet = zcashWalletNetwork $ entityVal w
pool <- runNoLoggingT $ initPool walletDb pool <- runNoLoggingT $ initPool walletDb
accs <- runNoLoggingT $ getAccounts pool $ entityKey w accs <- runNoLoggingT $ getAccounts pool $ entityKey w
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
intAddrs <- intAddrs <-
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- runNoLoggingT $ getMaxBlock pool chainTip <- getMaxBlock pool znet
let lastBlock = zcashWalletLastSync $ entityVal w let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
sapNotes <- sapNotes <-
liftIO $ liftIO $

View file

@ -450,14 +450,17 @@ saveAccount pool a =
-- | Returns the largest block in storage -- | Returns the largest block in storage
getMaxBlock :: getMaxBlock ::
Pool SqlBackend -- ^ The database pool Pool SqlBackend -- ^ The database pool
-> NoLoggingT IO Int -> ZcashNetDB
getMaxBlock pool = do -> IO Int
getMaxBlock pool net = do
b <- b <-
runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
txs <- from $ table @ZcashTransaction txs <- from $ table @ZcashTransaction
where_ (txs ^. ZcashTransactionBlock >. val 0) where_ (txs ^. ZcashTransactionBlock >. val 0)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy [desc $ txs ^. ZcashTransactionBlock] orderBy [desc $ txs ^. ZcashTransactionBlock]
pure txs pure txs
case b of case b of
@ -645,14 +648,16 @@ saveTransaction pool t n wt =
getZcashTransactions :: getZcashTransactions ::
ConnectionPool -- ^ The database path ConnectionPool -- ^ The database path
-> Int -- ^ Block -> Int -- ^ Block
-> ZcashNet -- ^ Network
-> IO [Entity ZcashTransaction] -> IO [Entity ZcashTransaction]
getZcashTransactions pool b = getZcashTransactions pool b net =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
select $ do select $ do
txs <- from $ table @ZcashTransaction txs <- from $ table @ZcashTransaction
where_ $ txs ^. ZcashTransactionBlock >. val b where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
orderBy [asc $ txs ^. ZcashTransactionBlock] orderBy [asc $ txs ^. ZcashTransactionBlock]
return txs return txs
@ -832,9 +837,10 @@ saveWalletOrchNote pool wId pos wit ch za zt dn = do
findTransparentNotes :: findTransparentNotes ::
ConnectionPool -- ^ The database path ConnectionPool -- ^ The database path
-> Int -- ^ Starting block -> Int -- ^ Starting block
-> ZcashNetDB -- ^ Network to use
-> Entity WalletAddress -> Entity WalletAddress
-> IO () -> IO ()
findTransparentNotes pool b t = do findTransparentNotes pool b net t = do
let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t) let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
case tReceiver of case tReceiver of
Just tR -> do Just tR -> do
@ -854,6 +860,7 @@ findTransparentNotes pool b t = do
(\(txs :& tNotes) -> (\(txs :& tNotes) ->
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx) txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
where_ (txs ^. ZcashTransactionBlock >. val b) where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
where_ (tNotes ^. TransparentNoteScript ==. val s) where_ (tNotes ^. TransparentNoteScript ==. val s)
pure (txs, tNotes) pure (txs, tNotes)
mapM_ mapM_
@ -907,8 +914,9 @@ saveSapNote pool wsn =
getShieldedOutputs :: getShieldedOutputs ::
ConnectionPool -- ^ database path ConnectionPool -- ^ database path
-> Int -- ^ block -> Int -- ^ block
-> ZcashNetDB -- ^ network to use
-> IO [(Entity ZcashTransaction, Entity ShieldOutput)] -> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
getShieldedOutputs pool b = getShieldedOutputs pool b net =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
@ -918,6 +926,7 @@ getShieldedOutputs pool b =
(\(txs :& sOutputs) -> (\(txs :& sOutputs) ->
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
where_ (txs ^. ZcashTransactionBlock >=. val b) where_ (txs ^. ZcashTransactionBlock >=. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy orderBy
[ asc $ txs ^. ZcashTransactionId [ asc $ txs ^. ZcashTransactionId
, asc $ sOutputs ^. ShieldOutputPosition , asc $ sOutputs ^. ShieldOutputPosition
@ -928,8 +937,9 @@ getShieldedOutputs pool b =
getOrchardActions :: getOrchardActions ::
ConnectionPool -- ^ database path ConnectionPool -- ^ database path
-> Int -- ^ block -> Int -- ^ block
-> ZcashNetDB -- ^ network to use
-> IO [(Entity ZcashTransaction, Entity OrchAction)] -> IO [(Entity ZcashTransaction, Entity OrchAction)]
getOrchardActions pool b = getOrchardActions pool b net =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
@ -939,6 +949,7 @@ getOrchardActions pool b =
(\(txs :& oActions) -> (\(txs :& oActions) ->
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
where_ (txs ^. ZcashTransactionBlock >=. val b) where_ (txs ^. ZcashTransactionBlock >=. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy orderBy
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
pure (txs, oActions) pure (txs, oActions)

View file

@ -1151,7 +1151,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- getMaxBlock pool $ ZcashNetDB net
let sb = max dbBlock b let sb = max dbBlock b
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of case confUp of

View file

@ -61,7 +61,7 @@ rescanZebra host port dbFilePath = do
pool3 <- runNoLoggingT $ initPool dbFilePath pool3 <- runNoLoggingT $ initPool dbFilePath
clearWalletTransactions pool1 clearWalletTransactions pool1
clearWalletData pool1 clearWalletData pool1
dbBlock <- runNoLoggingT $ getMaxBlock pool1 dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1 b <- liftIO $ getMinBirthdayHeight pool1
let sb = max dbBlock b let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1