From 302cfb0b76203c684e0c468c9eca8a5de71d7c65 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Sun, 29 Sep 2024 12:32:12 -0500 Subject: [PATCH] Add Logging to sync --- src/Zenith/CLI.hs | 39 +++++++++++++++++++++++++++------------ src/Zenith/Core.hs | 26 +++++++++++++++++--------- src/Zenith/DB.hs | 15 +++++++++------ src/Zenith/GUI.hs | 3 ++- src/Zenith/Scanner.hs | 14 ++++++++++---- test/Spec.hs | 22 +++++++++++++++------- 6 files changed, 80 insertions(+), 39 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 10e34bc..5a89a8b 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -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) diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 83f27d0..fcfed56 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 746ecc9..f0b2a4e 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -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 diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 16eabef..b3b8174 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -1220,7 +1220,8 @@ handleEvent wenv node model evt = case currentWallet of Nothing -> return $ ShowError "No wallet available" Just cW -> do - syncWallet (model ^. configuration) cW + runFileLoggingT "zenith.log" $ + syncWallet (model ^. configuration) cW pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index 10ca49d..7642d86 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs index 7c1ea78..96523c0 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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")