src/Zenith/CLI.hs

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

src/Zenith/Core.hs

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

src/Zenith/DB.hs

@@ -218,14 +218,14 @@ share
     UniqueTx blockId txId
     deriving Show Eq
   TransparentNote
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     value Int64
     script BS.ByteString
     position Int
     UniqueTNPos tx position
     deriving Show Eq
   TransparentSpend
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     outPointHash HexStringDB
     outPointIndex Word64
     script BS.ByteString
@@ -234,7 +234,7 @@ share
     UniqueTSPos tx position
     deriving Show Eq
   OrchAction
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     nf HexStringDB
     rk HexStringDB
     cmx HexStringDB
@@ -247,7 +247,7 @@ share
     UniqueOAPos tx position
     deriving Show Eq
   ShieldOutput
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     cv HexStringDB
     cmu HexStringDB
     ephKey HexStringDB
@@ -258,7 +258,7 @@ share
     UniqueSOPos tx position
     deriving Show Eq
   ShieldSpend
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     cv HexStringDB
     anchor HexStringDB
     nullifier HexStringDB
@@ -1611,24 +1611,10 @@ getOrchardCmxs pool zt = do
 getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
 getMaxOrchardNote pool = do
   flip PS.runSqlPool pool $ do
-    maxBlock <-
-      selectOne $ do
-        blks <- from $ table @ZcashBlock
-        where_ $ blks ^. ZcashBlockHeight >. val 0
-        pure $ blks ^. ZcashBlockHeight
-    case maxBlock of
-      Nothing -> return $ toSqlKey 0
-      Just (Value mb) -> do
     x <-
       selectOne $ do
-            (blks :& txs :& n) <-
+        n <- from $ table @OrchAction
-              from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
+        where_ (n ^. OrchActionId >. val (toSqlKey 0))
-              (\(blks :& txs) ->
-                 blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
-              table @OrchAction `on`
-              (\(_ :& txs :& n) ->
-                 txs ^. ZcashTransactionId ==. n ^. OrchActionTx)
-            where_ (blks ^. ZcashBlockHeight <=. val (mb - 5))
         orderBy [desc $ n ^. OrchActionId]
         pure (n ^. OrchActionId)
     case x of
@@ -1864,9 +1850,6 @@ clearWalletData pool = do
       delete $ do
         _ <- from $ table @ZcashTransaction
         return ()
-      delete $ do
-        _ <- from $ table @ZcashBlock
-        return ()
 
 getWalletUnspentTrNotes ::
      ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
@@ -2307,5 +2290,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,7 +1220,6 @@ 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,13 +6,7 @@ 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
+import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
-  ( NoLoggingT
-  , logErrorN
-  , logInfoN
-  , runFileLoggingT
-  , runNoLoggingT
-  )
 import Data.Aeson
 import Data.HexString
 import qualified Data.Text as T
@@ -67,8 +61,8 @@ rescanZebra host port dbFilePath = do
     Right bStatus -> do
       let znet = ZcashNetDB $ zgb_net bStatus
       pool1 <- runNoLoggingT $ initPool dbFilePath
-      {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
+      pool2 <- runNoLoggingT $ initPool dbFilePath
-      {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
+      pool3 <- runNoLoggingT $ initPool dbFilePath
       clearWalletTransactions pool1
       clearWalletData pool1
       dbBlock <- getMaxBlock pool1 znet
@@ -219,7 +213,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 <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
+          r <- 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 4)
+          oNotes <- getWalletUnspentSapNotes pool (toSqlKey 1)
           oNotes `shouldBe` []
         it "Check transparent notes" $ do
           pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@@ -265,14 +265,12 @@ main = do
                     18232
                     TestNet
                     (toSqlKey 1)
-                    3001230
+                    2999946
                     0.005
                     (fromJust uaRead)
                     "Sending memo to orchard"
                     Full
-                case tx of
+                tx `shouldBe` Right (hexString "deadbeef")
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
           it "To Sapling" $ do
             let uaRead =
                   parseAddress
@@ -288,61 +286,10 @@ main = do
                     "localhost"
                     18232
                     TestNet
-                    (toSqlKey 4)
+                    (toSqlKey 1)
-                    3001230
+                    2999396
                     0.005
                     (fromJust uaRead)
-                    "Sending memo to sapling"
+                    "Sending memo to orchard"
                     Full
-                case tx of
+                tx `shouldBe` Right (hexString "deadbeef")
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
-        describe "Medium" $ do
-          xit "To Orchard" $ do
-            let uaRead =
-                  parseAddress
-                    "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-            case uaRead of
-              Nothing -> assertFailure "wrong address"
-              Just ua -> do
-                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                tx <-
-                  runFileLoggingT "zenith.log" $
-                  prepareTxV2
-                    pool
-                    "localhost"
-                    18232
-                    TestNet
-                    (toSqlKey 1)
-                    3000789
-                    0.005
-                    (fromJust uaRead)
-                    "Sending memo to orchard"
-                    Medium
-                case tx of
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
-          xit "To Sapling" $ do
-            let uaRead =
-                  parseAddress
-                    "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
-            case uaRead of
-              Nothing -> assertFailure "wrong address"
-              Just ua -> do
-                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                tx <-
-                  runFileLoggingT "zenith.log" $
-                  prepareTxV2
-                    pool
-                    "localhost"
-                    18232
-                    TestNet
-                    (toSqlKey 1)
-                    3000789
-                    0.005
-                    (fromJust uaRead)
-                    "Sending memo to orchard"
-                    Medium
-                case tx of
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")

zcash-haskell

@@ -1 +1 @@
-Subproject commit 12296026a0ebb9a5afe0904b251c5d31080eab18
+Subproject commit 63a97b880cb32d8e008650f0efef2fdadc7d3d4a