Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 6 Packages Wiki Activity

Add Logging to sync

Browse source
This commit is contained in:
Rene Vergara 2024-09-29 12:32:12 -05:00
parent 6a4bbb587c
commit 302cfb0b76
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
6 changed files with 80 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
src/Zenith/CLI.hs
View file

@ -63,7 +63,12 @@ import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, unless, void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Control.Monad.Logger
( LoggingT
, logDebugN
, runFileLoggingT
, runNoLoggingT
)
import Data.Aeson
import Data.HexString (HexString(..), toText)
import Data.Maybe
@ -717,17 +722,22 @@ abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar"
scanZebra ::
T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
T.Text
-> T.Text
-> Int
-> Int
-> BC.BChan Tick
-> ZcashNet
-> LoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP
dbBlock <- getMaxBlock pool $ ZcashNetDB znet
chkBlock <- checkIntegrity dbP zHost zPort dbBlock 1
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
logDebugN $
"dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then do
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
@ -737,9 +747,12 @@ scanZebra dbP zHost zPort b eChan znet = do
then do
let step =
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
mapM_ (processBlock pool step) bList
mapM_ (liftIO . processBlock pool step) bList
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO
(Either IOError ())
case confUp of
Left _e0 ->
liftIO $
@ -823,6 +836,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w
_ <-
liftIO $
runFileLoggingT "zenith.log" $
syncWallet
(Config
(s ^. dbPath)
@ -859,6 +873,7 @@ appEvent (BT.AppEvent t) = do
_ <-
liftIO $
forkIO $
runFileLoggingT "zenith.log" $
scanZebra
(s ^. dbPath)
(s ^. zebraHost)

26
src/Zenith/Core.hs
View file

@ -1107,22 +1107,30 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
syncWallet ::
Config -- ^ configuration parameters
-> Entity ZcashWallet
-> IO ()
-> LoggingT IO ()
syncWallet config w = do
startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config
let znet = zcashWalletNetwork $ entityVal w
pool <- runNoLoggingT $ initPool walletDb
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
pool <- liftIO $ runNoLoggingT $ initPool walletDb
accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w
logDebugN $ "Accounts: " <> T.pack (show accs)
addrs <-
concat <$>
mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
logDebugN $ "addrs: " <> T.pack (show addrs)
intAddrs <-
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- getMaxBlock pool znet
concat <$>
mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- liftIO $ getMaxBlock pool znet
logDebugN $ "chain tip: " <> T.pack (show chainTip)
let lastBlock = zcashWalletLastSync $ entityVal w
logDebugN $ "last block: " <> T.pack (show lastBlock)
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
logDebugN $ "start block: " <> T.pack (show startBlock)
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
@ -1136,7 +1144,7 @@ syncWallet config w = do
mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs
_ <- updateSaplingWitnesses pool
_ <- updateOrchardWitnesses pool
_ <- liftIO $ updateSaplingWitnesses pool
_ <- liftIO $ updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs

15
src/Zenith/DB.hs
View file

@ -218,14 +218,14 @@ share
UniqueTx blockId txId
deriving Show Eq
TransparentNote
tx ZcashTransactionId
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
value Int64
script BS.ByteString
position Int
UniqueTNPos tx position
deriving Show Eq
TransparentSpend
tx ZcashTransactionId
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
outPointHash HexStringDB
outPointIndex Word64
script BS.ByteString
@ -234,7 +234,7 @@ share
UniqueTSPos tx position
deriving Show Eq
OrchAction
tx ZcashTransactionId
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
nf HexStringDB
rk HexStringDB
cmx HexStringDB
@ -247,7 +247,7 @@ share
UniqueOAPos tx position
deriving Show Eq
ShieldOutput
tx ZcashTransactionId
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
cv HexStringDB
cmu HexStringDB
ephKey HexStringDB
@ -258,7 +258,7 @@ share
UniqueSOPos tx position
deriving Show Eq
ShieldSpend
tx ZcashTransactionId
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
cv HexStringDB
anchor HexStringDB
nullifier HexStringDB
@ -1864,6 +1864,9 @@ clearWalletData pool = do
delete $ do
_ <- from $ table @ZcashTransaction
return ()
delete $ do
_ <- from $ table @ZcashBlock
return ()
getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
@ -2304,5 +2307,5 @@ rewindWalletData pool b = do
flip PS.runSqlPool pool $
delete $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
where_ $ blk ^. ZcashBlockHeight >=. val b
clearWalletTransactions pool

1
src/Zenith/GUI.hs
View file

@ -1220,6 +1220,7 @@ handleEvent wenv node model evt =
case currentWallet of
Nothing -> return $ ShowError "No wallet available"
Just cW -> do
runFileLoggingT "zenith.log" $
syncWallet (model ^. configuration) cW
pool <-
runNoLoggingT $

14
src/Zenith/Scanner.hs
View file

@ -6,7 +6,13 @@ import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
import Control.Monad.Logger
( NoLoggingT
, logErrorN
, logInfoN
, runFileLoggingT
, runNoLoggingT
)
import Data.Aeson
import Data.HexString
import qualified Data.Text as T
@ -61,8 +67,8 @@ rescanZebra host port dbFilePath = do
Right bStatus -> do
let znet = ZcashNetDB $ zgb_net bStatus
pool1 <- runNoLoggingT $ initPool dbFilePath
pool2 <- runNoLoggingT $ initPool dbFilePath
pool3 <- runNoLoggingT $ initPool dbFilePath
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
clearWalletTransactions pool1
clearWalletData pool1
dbBlock <- getMaxBlock pool1 znet
@ -213,7 +219,7 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- mapM (syncWallet config) w'
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
liftIO $ print r
-- | Detect chain re-orgs

22
test/Spec.hs
View file

@ -241,7 +241,7 @@ main = do
oNotes `shouldBe` []
it "Check Sapling notes" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 1)
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
oNotes `shouldBe` []
it "Check transparent notes" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@ -265,12 +265,14 @@ main = do
18232
TestNet
(toSqlKey 1)
3000785
3001230
0.005
(fromJust uaRead)
"Sending memo to orchard"
Full
tx `shouldBe` Right (hexString "deadbeef")
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Sapling" $ do
let uaRead =
parseAddress
@ -287,12 +289,14 @@ main = do
18232
TestNet
(toSqlKey 4)
3000789
3001230
0.005
(fromJust uaRead)
"Sending memo to sapling"
Full
tx `shouldBe` Right (hexString "deadbeef")
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
describe "Medium" $ do
xit "To Orchard" $ do
let uaRead =
@ -315,7 +319,9 @@ main = do
(fromJust uaRead)
"Sending memo to orchard"
Medium
tx `shouldBe` Right (hexString "deadbeef")
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
xit "To Sapling" $ do
let uaRead =
parseAddress
@ -337,4 +343,6 @@ main = do
(fromJust uaRead)
"Sending memo to orchard"
Medium
tx `shouldBe` Right (hexString "deadbeef")
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")