rvv001 - Merge branch 'rav001' into rvv001

src/Zenith/CLI.hs

@@ -839,7 +839,7 @@ scanZebra dbP zHost zPort b eChan znet = do
       logDebugN $
         "dbBlock: " <>
         T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
-      when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
+      when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
       let sb =
             if chkBlock == dbBlock
               then max dbBlock b
@@ -953,7 +953,7 @@ appEvent (BT.AppEvent t) = do
                      Just (_k, w) -> return w
               _ <-
                 liftIO $
-                runNoLoggingT $
+                runStderrLoggingT $
                 syncWallet
                   (Config
                      (s ^. dbPath)

src/Zenith/Core.hs

@@ -60,6 +60,7 @@ import ZcashHaskell.Sapling
   , genSaplingInternalAddress
   , genSaplingPaymentAddress
   , genSaplingSpendingKey
+  , getSaplingFrontier
   , getSaplingNotePosition
   , getSaplingWitness
   , updateSaplingCommitmentTree
@@ -279,70 +280,86 @@ findSaplingOutputs ::
   -> Int -- ^ the starting block
   -> ZcashNetDB -- ^ The network
   -> Entity ZcashAccount -- ^ The account to use
-  -> IO ()
+  -> LoggingT IO ()
 findSaplingOutputs config b znet za = do
   let dbPath = c_dbPath config
   let zebraHost = c_zebraHost config
   let zebraPort = c_zebraPort config
   let zn = getNet znet
-  pool <- runNoLoggingT $ initPool dbPath
-  tList <- getShieldedOutputs pool b znet
-  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
-  let sT = SaplingCommitmentTree $ ztiSapling trees
-  decryptNotes sT zn pool tList
-  sapNotes <- getWalletSapNotes pool (entityKey za)
-  findSapSpends pool (entityKey za) sapNotes
+  pool <- liftIO $ runNoLoggingT $ initPool dbPath
+  tList <- liftIO $ getShieldedOutputs pool b znet
+  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
+  logDebugN "getting Sapling frontier"
+  let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
+  case sT of
+    Nothing ->
+      liftIO $ throwIO $ userError "Failed to read Sapling commitment tree"
+    Just sT' -> do
+      logDebugN "Sapling frontier valid"
+      decryptNotes sT' zn pool tList
+      sapNotes <- liftIO $ getWalletSapNotes pool (entityKey za)
+      liftIO $ findSapSpends pool (entityKey za) sapNotes
   where
     sk :: SaplingSpendingKeyDB
     sk = zcashAccountSapSpendKey $ entityVal za
     decryptNotes ::
-         SaplingCommitmentTree
+         SaplingFrontier
       -> ZcashNet
       -> ConnectionPool
       -> [(Entity ZcashTransaction, Entity ShieldOutput)]
-      -> IO ()
+      -> LoggingT IO ()
     decryptNotes _ _ _ [] = return ()
     decryptNotes st n pool ((zt, o):txs) = do
       let updatedTree =
             updateSaplingCommitmentTree
               st
               (getHex $ shieldOutputCmu $ entityVal o)
+      logDebugN "updated frontier"
       case updatedTree of
-        Nothing -> throwIO $ userError "Failed to update commitment tree"
+        Nothing ->
+          liftIO $ throwIO $ userError "Failed to update commitment tree"
         Just uT -> do
           let noteWitness = getSaplingWitness uT
+          logDebugN "got witness"
           let notePos = getSaplingNotePosition <$> noteWitness
+          logDebugN "got position"
           case notePos of
-            Nothing -> throwIO $ userError "Failed to obtain note position"
+            Nothing ->
+              liftIO $ throwIO $ userError "Failed to obtain note position"
             Just nP -> do
               case decodeShOut External n nP o of
                 Nothing -> do
+                  logDebugN "couldn't decode external"
                   case decodeShOut Internal n nP o of
                     Nothing -> do
+                      logDebugN "couldn't decode internal"
                       decryptNotes uT n pool txs
                     Just dn1 -> do
-                      wId <- saveWalletTransaction pool (entityKey za) zt
-                      saveWalletSapNote
-                        pool
-                        wId
-                        nP
-                        (fromJust noteWitness)
-                        True
-                        (entityKey za)
-                        (entityKey o)
-                        dn1
+                      wId <-
+                        liftIO $ saveWalletTransaction pool (entityKey za) zt
+                      liftIO $
+                        saveWalletSapNote
+                          pool
+                          wId
+                          nP
+                          (fromJust noteWitness)
+                          True
+                          (entityKey za)
+                          (entityKey o)
+                          dn1
                       decryptNotes uT n pool txs
                 Just dn0 -> do
-                  wId <- saveWalletTransaction pool (entityKey za) zt
-                  saveWalletSapNote
-                    pool
-                    wId
-                    nP
-                    (fromJust noteWitness)
-                    False
-                    (entityKey za)
-                    (entityKey o)
-                    dn0
+                  wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
+                  liftIO $
+                    saveWalletSapNote
+                      pool
+                      wId
+                      nP
+                      (fromJust noteWitness)
+                      False
+                      (entityKey za)
+                      (entityKey o)
+                      dn0
                   decryptNotes uT n pool txs
     decodeShOut ::
          Scope
@@ -926,7 +943,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
                       oSpends
                       dummy
                       zn
-                      (bh + 3)
+                      bh
                       False
               case feeResponse of
                 Left e1 -> return $ Left Fee
@@ -985,7 +1002,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
                                   oSpends1
                                   outgoing
                                   zn
-                                  (bh + 3)
+                                  bh
                                   True
                           logDebugN $ T.pack $ show tx
                           return tx
@@ -1261,14 +1278,14 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
 syncWallet ::
      Config -- ^ configuration parameters
   -> Entity ZcashWallet
-  -> NoLoggingT IO ()
+  -> LoggingT IO ()
 syncWallet config w = do
   startTime <- liftIO getCurrentTime
+  logDebugN $ T.pack $ show startTime
   let walletDb = c_dbPath config
   let znet = zcashWalletNetwork $ entityVal w
   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
@@ -1278,7 +1295,7 @@ syncWallet config w = do
     mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs
   chainTip <- liftIO $ getMaxBlock pool znet
   logDebugN $ "chain tip: " <> T.pack (show chainTip)
-  let lastBlock = zcashWalletLastSync $ entityVal w
+  lastBlock <- liftIO $ getLastSyncBlock pool $ entityKey w
   logDebugN $ "last block: " <> T.pack (show lastBlock)
   let startBlock =
         if lastBlock > 0
@@ -1287,18 +1304,22 @@ syncWallet config w = do
   logDebugN $ "start block: " <> T.pack (show startBlock)
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
+  logDebugN "processed transparent notes"
   mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
-  sapNotes <-
-    liftIO $
-    mapM
-      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
-      accs
-  orchNotes <-
-    liftIO $
-    mapM
+  logDebugN "processed transparent spends"
+  mapM_
+    (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
+    accs
+  logDebugN "processed sapling outputs"
+  liftIO $
+    mapM_
       (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
       accs
+  logDebugN "processed orchard actions"
   _ <- liftIO $ updateSaplingWitnesses pool
+  logDebugN "updated sapling witnesses"
   _ <- liftIO $ updateOrchardWitnesses pool
+  logDebugN "updated orchard witnesses"
   _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
+  logDebugN "updated wallet lastSync"
   mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs

src/Zenith/DB.hs

@@ -21,7 +21,13 @@ module Zenith.DB where
 import Control.Exception (SomeException(..), throw, throwIO, try)
 import Control.Monad (unless, when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
+import Control.Monad.Logger
+  ( LoggingT
+  , NoLoggingT
+  , logDebugN
+  , runNoLoggingT
+  , runStderrLoggingT
+  )
 import qualified Data.ByteString as BS
 import Data.HexString
 import Data.Int
@@ -1783,15 +1789,30 @@ getSaplingCmus pool zt = do
 getMaxSaplingNote :: Pool SqlBackend -> IO ShieldOutputId
 getMaxSaplingNote pool = do
   flip PS.runSqlPool pool $ do
-    x <-
+    maxBlock <-
       selectOne $ do
-        n <- from $ table @ShieldOutput
-        where_ (n ^. ShieldOutputId >. val (toSqlKey 0))
-        orderBy [desc $ n ^. ShieldOutputId]
-        pure (n ^. ShieldOutputId)
-    case x of
+        blks <- from $ table @ZcashBlock
+        where_ $ blks ^. ZcashBlockHeight >. val 0
+        orderBy [desc $ blks ^. ZcashBlockHeight]
+        pure $ blks ^. ZcashBlockHeight
+    case maxBlock of
       Nothing -> return $ toSqlKey 0
-      Just (Value y) -> return y
+      Just (Value mb) -> do
+        x <-
+          selectOne $ do
+            (blks :& txs :& n) <-
+              from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
+              (\(blks :& txs) ->
+                 blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
+              table @ShieldOutput `on`
+              (\(_ :& txs :& n) ->
+                 txs ^. ZcashTransactionId ==. n ^. ShieldOutputTx)
+            where_ (blks ^. ZcashBlockHeight <=. val (mb - 5))
+            orderBy [desc $ n ^. ShieldOutputId]
+            pure (n ^. ShieldOutputId)
+        case x of
+          Nothing -> return $ toSqlKey 0
+          Just (Value y) -> return y
 
 updateSapNoteRecord ::
      Pool SqlBackend
@@ -1836,6 +1857,7 @@ getMaxOrchardNote pool = do
       selectOne $ do
         blks <- from $ table @ZcashBlock
         where_ $ blks ^. ZcashBlockHeight >. val 0
+        orderBy [desc $ blks ^. ZcashBlockHeight]
         pure $ blks ^. ZcashBlockHeight
     case maxBlock of
       Nothing -> return $ toSqlKey 0
@@ -2052,22 +2074,22 @@ rewindWalletTransactions pool b = do
         x <- from $ table @WalletOrchNote
         where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys
         return ()
-      delete $ do
-        x <- from $ table @WalletSapNote
-        where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
-        return ()
       delete $ do
         x <- from $ table @WalletSapSpend
         where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys
         return ()
       delete $ do
-        x <- from $ table @WalletTrNote
-        where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
+        x <- from $ table @WalletSapNote
+        where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
         return ()
       delete $ do
         x <- from $ table @WalletTrSpend
         where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys
         return ()
+      delete $ do
+        x <- from $ table @WalletTrNote
+        where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
+        return ()
       delete $ do
         txs <- from $ table @WalletTransaction
         where_ $ txs ^. WalletTransactionBlock >. val b
@@ -2621,10 +2643,14 @@ completeSync pool st = do
   return ()
 
 -- | Rewind the data store to a given block height
-rewindWalletData :: ConnectionPool -> Int -> IO ()
+rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
 rewindWalletData pool b = do
-  rewindWalletTransactions pool b
-  runNoLoggingT $
+  logDebugN "Starting transaction rewind"
+  liftIO $ clearWalletTransactions pool
+  logDebugN "Completed transaction rewind"
+  logDebugN "Starting data store rewind"
+  _ <-
+    runStderrLoggingT $
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
       oldBlocks <-
@@ -2642,21 +2668,112 @@ rewindWalletData pool b = do
       delete $ do
         x <- from $ table @TransparentNote
         where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
+  logDebugN "Completed TransparentNote delete"
+  _ <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      oldBlocks <-
+        select $ do
+          blk <- from $ table @ZcashBlock
+          where_ $ blk ^. ZcashBlockHeight >. val b
+          pure blk
+      let oldBlkKeys = map entityKey oldBlocks
+      oldTxs <-
+        select $ do
+          txs <- from $ table @ZcashTransaction
+          where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
+          pure txs
+      let oldTxKeys = map entityKey oldTxs
       delete $ do
         x <- from $ table @TransparentSpend
         where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
+  logDebugN "Completed TransparentSpend delete"
+  _ <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      oldBlocks <-
+        select $ do
+          blk <- from $ table @ZcashBlock
+          where_ $ blk ^. ZcashBlockHeight >. val b
+          pure blk
+      let oldBlkKeys = map entityKey oldBlocks
+      oldTxs <-
+        select $ do
+          txs <- from $ table @ZcashTransaction
+          where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
+          pure txs
+      let oldTxKeys = map entityKey oldTxs
       delete $ do
         x <- from $ table @ShieldOutput
         where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
+  logDebugN "Completed ShieldOutput delete"
+  _ <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      oldBlocks <-
+        select $ do
+          blk <- from $ table @ZcashBlock
+          where_ $ blk ^. ZcashBlockHeight >. val b
+          pure blk
+      let oldBlkKeys = map entityKey oldBlocks
+      oldTxs <-
+        select $ do
+          txs <- from $ table @ZcashTransaction
+          where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
+          pure txs
+      let oldTxKeys = map entityKey oldTxs
       delete $ do
         x <- from $ table @ShieldSpend
         where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
+  logDebugN "Completed ShieldSpend delete"
+  _ <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      oldBlocks <-
+        select $ do
+          blk <- from $ table @ZcashBlock
+          where_ $ blk ^. ZcashBlockHeight >. val b
+          pure blk
+      let oldBlkKeys = map entityKey oldBlocks
+      oldTxs <-
+        select $ do
+          txs <- from $ table @ZcashTransaction
+          where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
+          pure txs
+      let oldTxKeys = map entityKey oldTxs
       delete $ do
         x <- from $ table @OrchAction
         where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
+  logDebugN "Completed OrchAction delete"
+  _ <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      oldBlocks <-
+        select $ do
+          blk <- from $ table @ZcashBlock
+          where_ $ blk ^. ZcashBlockHeight >. val b
+          pure blk
+      let oldBlkKeys = map entityKey oldBlocks
+      oldTxs <-
+        select $ do
+          txs <- from $ table @ZcashTransaction
+          where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
+          pure txs
+      let oldTxKeys = map entityKey oldTxs
       delete $ do
         x <- from $ table @ZcashTransaction
         where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
+  logDebugN "Completed ZcashTransaction delete"
+  _ <-
+    runStderrLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
       delete $ do
         blk <- from $ table @ZcashBlock
         where_ $ blk ^. ZcashBlockHeight >. val b
+  logDebugN "Completed data store rewind"

src/Zenith/GUI.hs

@@ -12,7 +12,7 @@ import Control.Concurrent (threadDelay)
 import Control.Exception (throwIO, try)
 import Control.Monad (unless, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.HexString (toText)
@@ -991,38 +991,24 @@ buildUI wenv model = widgetTree
                       , spacer
                       , hstack
                           [ filler
-                          , label ("Amount : " ) `styleBasic`
+                          , label ("Amount : ") `styleBasic`
                             [width 50, textFont "Bold"]
                           , spacer
-                          , label (displayAmount (model ^. network) 100 ) `styleBasic`
+                          , label (displayAmount (model ^. network) 100) `styleBasic`
                             [width 50, textFont "Bold"]
                           , filler
---                          , spacer
---                          , numericField_
---                              sendAmount
---                              [ decimals 8
---                              , minValue 0.0
---                              , maxValue
---                                  (fromIntegral (model ^. tBalance) / 100000000.0)
---                              , validInput tBalanceValid
---                              , onChange CheckAmount
---                              ] `styleBasic`
---                            [ width 150
---                            , styleIf
---                                (not $ model ^. tBalanceValid)
---                                (textColor red)
---                            ]
                           ]
                       , spacer
                       , box_
                           [alignMiddle]
                           (hstack
-                              [ filler 
-                              , mainButton "Proceed" NotImplemented `nodeEnabled` True
---                               (model ^. amountValid && model ^. recipientValid)
-                              , spacer 
-                              , mainButton "Cancel" CloseShield `nodeEnabled` True
-                              , filler
+                             [ filler
+                             , mainButton "Proceed" NotImplemented `nodeEnabled`
+                               True
+                             , spacer
+                             , mainButton "Cancel" CloseShield `nodeEnabled`
+                               True
+                             , filler
                              ])
                       ]) `styleBasic`
                  [radius 4, border 2 btnColor, bgColor white, padding 4]
@@ -1047,13 +1033,15 @@ buildUI wenv model = widgetTree
                       , separatorLine `styleBasic` [fgColor btnColor]
                       , spacer
                       , hstack
-                          [ (label "Total Transparent : " `styleBasic` [ textFont "Bold" ]) 
-                          , (label "0.00" )
+                          [ (label "Total Transparent : " `styleBasic`
+                             [textFont "Bold"])
+                          , (label "0.00")
                           ]
                       , spacer
                       , hstack
-                          [ (label "Total Shielded : " `styleBasic` [ textFont "Bold" ]) 
-                          , (label "0.00" )
+                          [ (label "Total Shielded : " `styleBasic`
+                             [textFont "Bold"])
+                          , (label "0.00")
                           ]
                       , spacer
                       , hstack
@@ -1065,7 +1053,8 @@ buildUI wenv model = widgetTree
                               [ decimals 8
                               , minValue 0.0
                               , maxValue
-                                  (fromIntegral (model ^. sBalance) / 100000000.0)
+                                  (fromIntegral (model ^. sBalance) /
+                                   100000000.0)
                               , validInput sBalanceValid
                               , onChange CheckAmount
                               ] `styleBasic`
@@ -1080,10 +1069,11 @@ buildUI wenv model = widgetTree
                           [alignMiddle]
                           (hstack
                              [ filler
-                             , mainButton "Proceed" NotImplemented `nodeEnabled` True
---                               (model ^. amountValid && model ^. recipientValid)
+                             , mainButton "Proceed" NotImplemented `nodeEnabled`
+                               True
                              , spacer
-                             , mainButton "Cancel" CloseDeShield `nodeEnabled` True
+                             , mainButton "Cancel" CloseDeShield `nodeEnabled`
+                               True
                              , filler
                              ])
                       ]) `styleBasic`
@@ -1093,6 +1083,24 @@ buildUI wenv model = widgetTree
            , filler
            ]) `styleBasic`
       [bgColor (white & L.a .~ 0.5)]
+
+--                          , spacer
+--                          , numericField_
+--                              sendAmount
+--                              [ decimals 8
+--                              , minValue 0.0
+--                              , maxValue
+--                                  (fromIntegral (model ^. tBalance) / 100000000.0)
+--                              , validInput tBalanceValid
+--                              , onChange CheckAmount
+--                              ] `styleBasic`
+--                            [ width 150
+--                            , styleIf
+--                                (not $ model ^. tBalanceValid)
+--                                (textColor red)
+--                            ]
+--                               (model ^. amountValid && model ^. recipientValid)
+--                               (model ^. amountValid && model ^. recipientValid)
 notImplemented = NotImplemented
 
 generateQRCodes :: Config -> IO ()
@@ -1391,7 +1399,7 @@ handleEvent wenv node model evt =
                  case currentWallet of
                    Nothing -> return $ ShowError "No wallet available"
                    Just cW -> do
-                     runNoLoggingT $ syncWallet (model ^. configuration) cW
+                     runStderrLoggingT $ syncWallet (model ^. configuration) cW
                      pool <-
                        runNoLoggingT $
                        initPool $ c_dbPath $ model ^. configuration
@@ -1482,9 +1490,9 @@ handleEvent wenv node model evt =
         model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
       ]
     CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
-    ShowShield ->  [ Model $ model & shieldZec .~ True & menuPopup .~ False ]
+    ShowShield -> [Model $ model & shieldZec .~ True & menuPopup .~ False]
     CloseShield -> [Model $ model & shieldZec .~ False]
-    ShowDeShield ->  [ Model $ model & deShieldZec .~ True & menuPopup .~ False ]
+    ShowDeShield -> [Model $ model & deShieldZec .~ True & menuPopup .~ False]
     CloseDeShield -> [Model $ model & deShieldZec .~ False]
     LoadAbList a -> [Model $ model & abaddressList .~ a]
     UpdateABDescrip d a ->
@@ -1623,7 +1631,8 @@ scanZebra dbPath zHost zPort net sendMsg = do
   if syncChk
     then sendMsg (ShowError "Sync already in progress")
     else do
-      unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
+      unless (chkBlock == dbBlock) $
+        runStderrLoggingT $ rewindWalletData pool chkBlock
       let sb =
             if chkBlock == dbBlock
               then max dbBlock b

src/Zenith/RPC.hs

@@ -892,7 +892,8 @@ scanZebra dbPath zHost zPort net = do
   chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
   syncChk <- isSyncing pool
   unless syncChk $ do
-    unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
+    unless (chkBlock == dbBlock) $
+      runStderrLoggingT $ rewindWalletData pool chkBlock
     let sb =
           if chkBlock == dbBlock
             then max dbBlock b
@@ -909,7 +910,7 @@ scanZebra dbPath zHost zPort net = do
             return ()
           Right _ -> do
             wals <- getWallets pool net
-            runNoLoggingT $
+            runStderrLoggingT $
               mapM_
                 (syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
                 wals

src/Zenith/Scanner.hs

@@ -10,8 +10,8 @@ import Control.Monad.Logger
   ( NoLoggingT
   , logErrorN
   , logInfoN
-  , runFileLoggingT
   , runNoLoggingT
+  , runStderrLoggingT
   )
 import Data.Aeson
 import Data.HexString
@@ -238,7 +238,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 <- runNoLoggingT $ mapM (syncWallet config) w'
+          r <- runStderrLoggingT $ mapM (syncWallet config) w'
           liftIO $ print r
 
 -- | Detect chain re-orgs

test/Spec.hs

@@ -212,8 +212,8 @@ main = do
                     "localhost"
                     18232
                     TestNet
-                    (toSqlKey 1)
-                    3001331
+                    (toSqlKey 3)
+                    3026170
                     [ ProposedNote
                         (ValidAddressAPI $ fromJust uaRead)
                         0.005
@@ -222,7 +222,7 @@ main = do
                     Full
                 case tx of
                   Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
+                  Right h -> h `shouldBe` (hexString "deadbeef")
           it "To Sapling" $ do
             let uaRead =
                   parseAddress

zcash-haskell

@@ -1 +1 @@
-Subproject commit 003293cc3f978c146824d0695c5c458cf2cc9bb5
+Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb