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.Exception (throw, throwIO, try)
import Control.Monad (forever, unless, void, when) import Control.Monad (forever, unless, void, when)
import Control.Monad.IO.Class (liftIO) 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.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
@ -717,17 +722,22 @@ abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar" 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
-> LoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- getMaxBlock pool $ ZcashNetDB znet dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- checkIntegrity dbP zHost zPort dbBlock 1 chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock logDebugN $
let sb = "dbBlock: " <>
if chkBlock == dbBlock T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
then max dbBlock b let sb = max dbBlock b
else max chkBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
@ -737,9 +747,12 @@ scanZebra dbP zHost zPort b eChan znet = do
then do then do
let step = let step =
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) (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 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 case confUp of
Left _e0 -> Left _e0 ->
liftIO $ liftIO $
@ -823,6 +836,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w Just (_k, w) -> return w
_ <- _ <-
liftIO $ liftIO $
runFileLoggingT "zenith.log" $
syncWallet syncWallet
(Config (Config
(s ^. dbPath) (s ^. dbPath)
@ -859,6 +873,7 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runFileLoggingT "zenith.log" $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (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 :: syncWallet ::
Config -- ^ configuration parameters Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> IO () -> LoggingT IO ()
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 let znet = zcashWalletNetwork $ entityVal w
pool <- runNoLoggingT $ initPool walletDb pool <- liftIO $ runNoLoggingT $ initPool walletDb
accs <- runNoLoggingT $ getAccounts pool $ entityKey w accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs logDebugN $ "Accounts: " <> T.pack (show accs)
addrs <-
concat <$>
mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
logDebugN $ "addrs: " <> T.pack (show addrs)
intAddrs <- intAddrs <-
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs concat <$>
chainTip <- getMaxBlock pool znet mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- liftIO $ getMaxBlock pool znet
logDebugN $ "chain tip: " <> T.pack (show chainTip)
let lastBlock = zcashWalletLastSync $ entityVal w let lastBlock = zcashWalletLastSync $ entityVal w
logDebugN $ "last block: " <> T.pack (show lastBlock)
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
logDebugN $ "start block: " <> T.pack (show startBlock)
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
@ -1136,7 +1144,7 @@ syncWallet config w = do
mapM mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w)) (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs accs
_ <- updateSaplingWitnesses pool _ <- liftIO $ updateSaplingWitnesses pool
_ <- updateOrchardWitnesses pool _ <- liftIO $ updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w) _ <- 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 UniqueTx blockId txId
deriving Show Eq deriving Show Eq
TransparentNote TransparentNote
tx ZcashTransactionId tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
value Int64 value Int64
script BS.ByteString script BS.ByteString
position Int position Int
UniqueTNPos tx position UniqueTNPos tx position
deriving Show Eq deriving Show Eq
TransparentSpend TransparentSpend
tx ZcashTransactionId tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
outPointHash HexStringDB outPointHash HexStringDB
outPointIndex Word64 outPointIndex Word64
script BS.ByteString script BS.ByteString
@ -234,7 +234,7 @@ share
UniqueTSPos tx position UniqueTSPos tx position
deriving Show Eq deriving Show Eq
OrchAction OrchAction
tx ZcashTransactionId tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
nf HexStringDB nf HexStringDB
rk HexStringDB rk HexStringDB
cmx HexStringDB cmx HexStringDB
@ -247,7 +247,7 @@ share
UniqueOAPos tx position UniqueOAPos tx position
deriving Show Eq deriving Show Eq
ShieldOutput ShieldOutput
tx ZcashTransactionId tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
cv HexStringDB cv HexStringDB
cmu HexStringDB cmu HexStringDB
ephKey HexStringDB ephKey HexStringDB
@ -258,7 +258,7 @@ share
UniqueSOPos tx position UniqueSOPos tx position
deriving Show Eq deriving Show Eq
ShieldSpend ShieldSpend
tx ZcashTransactionId tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
cv HexStringDB cv HexStringDB
anchor HexStringDB anchor HexStringDB
nullifier HexStringDB nullifier HexStringDB
@ -1864,6 +1864,9 @@ clearWalletData pool = do
delete $ do delete $ do
_ <- from $ table @ZcashTransaction _ <- from $ table @ZcashTransaction
return () return ()
delete $ do
_ <- from $ table @ZcashBlock
return ()
getWalletUnspentTrNotes :: getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
@ -2304,5 +2307,5 @@ rewindWalletData pool b = do
flip PS.runSqlPool pool $ flip PS.runSqlPool pool $
delete $ do delete $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_ $ blk ^. ZcashBlockHeight >=. val b
clearWalletTransactions pool clearWalletTransactions pool

1
src/Zenith/GUI.hs
View file

@ -1220,6 +1220,7 @@ handleEvent wenv node model evt =
case currentWallet of case currentWallet of
Nothing -> return $ ShowError "No wallet available" Nothing -> return $ ShowError "No wallet available"
Just cW -> do Just cW -> do
runFileLoggingT "zenith.log" $
syncWallet (model ^. configuration) cW syncWallet (model ^. configuration) cW
pool <- pool <-
runNoLoggingT $ 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.Exception (throwIO, try)
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) 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.Aeson
import Data.HexString import Data.HexString
import qualified Data.Text as T import qualified Data.Text as T
@ -61,8 +67,8 @@ rescanZebra host port dbFilePath = do
Right bStatus -> do Right bStatus -> do
let znet = ZcashNetDB $ zgb_net bStatus let znet = ZcashNetDB $ zgb_net bStatus
pool1 <- runNoLoggingT $ initPool dbFilePath pool1 <- runNoLoggingT $ initPool dbFilePath
pool2 <- runNoLoggingT $ initPool dbFilePath {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
pool3 <- runNoLoggingT $ initPool dbFilePath {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
clearWalletTransactions pool1 clearWalletTransactions pool1
clearWalletData pool1 clearWalletData pool1
dbBlock <- getMaxBlock pool1 znet dbBlock <- getMaxBlock pool1 znet
@ -213,7 +219,7 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- mapM (syncWallet config) w' r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r
-- | Detect chain re-orgs -- | Detect chain re-orgs

22
test/Spec.hs
View file

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