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)

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

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

src/Zenith/GUI.hs

@@ -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 $

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

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")