Implement database migration

app/Main.hs

@@ -19,8 +19,8 @@ import System.IO
 import Text.Read (readMaybe)
 import ZcashHaskell.Types
 import Zenith.CLI
-import Zenith.Core (clearSync, testSync)
 import Zenith.GUI (runZenithGUI)
+import Zenith.Scanner (clearSync, rescanZebra)
 import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
 import Zenith.Utils
 import Zenith.Zcashd
@@ -227,7 +227,7 @@ main = do
             of
         "gui" -> runZenithGUI myConfig
         "tui" -> runZenithTUI myConfig
-        "rescan" -> clearSync myConfig
+        "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
         _ -> printUsage
     else printUsage
 

app/Server.hs

@@ -2,10 +2,16 @@
 
 module Server where
 
+import Control.Exception (throwIO, try)
+import Control.Monad (when)
 import Data.Configurator
 import Network.Wai.Handler.Warp (run)
 import Servant
+import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
+import Zenith.Core (checkBlockChain, checkZebra)
+import Zenith.DB (initDb)
 import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer)
+import Zenith.Scanner (rescanZebra)
 import Zenith.Types (Config(..))
 
 main :: IO ()
@@ -19,5 +25,22 @@ main = do
   nodePort <- require config "nodePort"
   let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
   let ctx = authenticate myConfig :. EmptyContext
-  run nodePort $
+  w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
-    serveWithContext (Proxy :: Proxy ZenithRPC) ctx (zenithServer myConfig)
+  case w of
+    Right zebra -> do
+      bc <-
+        try $ checkBlockChain zebraHost zebraPort :: IO
+          (Either IOError ZebraGetBlockChainInfo)
+      case bc of
+        Left e1 -> throwIO e1
+        Right chainInfo -> do
+          x <- initDb dbFilePath
+          case x of
+            Left e2 -> throwIO $ userError e2
+            Right x' -> do
+              when x' $ rescanZebra zebraHost zebraPort dbFilePath
+              run nodePort $
+                serveWithContext
+                  (Proxy :: Proxy ZenithRPC)
+                  ctx
+                  (zenithServer myConfig)

app/ZenScan.hs

@@ -4,7 +4,7 @@ module ZenScan where
 
 import Control.Monad.Logger (runNoLoggingT)
 import Data.Configurator
-import Zenith.Scanner (scanZebra)
+import Zenith.Scanner (rescanZebra)
 
 main :: IO ()
 main = do

src/Zenith/CLI.hs

@@ -10,10 +10,8 @@ import qualified Brick.BChan as BC
 import qualified Brick.Focus as F
 import Brick.Forms
   ( Form(..)
-  , FormFieldState
   , (@@=)
   , allFieldsValid
-  , editShowableField
   , editShowableFieldWithValidate
   , editTextField
   , focusedFormInputAttr
@@ -42,7 +40,6 @@ import Brick.Widgets.Core
   , joinBorders
   , padAll
   , padBottom
-  , padLeft
   , padTop
   , setAvailableSize
   , str
@@ -63,10 +60,10 @@ import qualified Brick.Widgets.Edit as E
 import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.ProgressBar as P
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (catch, throw, throwIO, try)
+import Control.Exception (throw, throwIO, try)
-import Control.Monad (forever, void)
+import Control.Monad (forever, void, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
+import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
 import Data.Aeson
 import Data.HexString (HexString(..), toText)
 import Data.Maybe
@@ -83,19 +80,15 @@ import Lens.Micro.Mtl
 import Lens.Micro.TH
 import System.Hclip
 import Text.Printf
-import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
+import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
-import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
+import ZcashHaskell.Keys (generateWalletSeedPhrase)
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
-import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
+import ZcashHaskell.Transparent (encodeTransparentReceiver)
-import ZcashHaskell.Transparent
-  ( decodeTransparentAddress
-  , encodeTransparentReceiver
-  )
 import ZcashHaskell.Types
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
-import Zenith.Scanner (processTx, updateConfs)
+import Zenith.Scanner (processTx, rescanZebra, updateConfs)
 import Zenith.Types
   ( Config(..)
   , PhraseDB(..)
@@ -722,9 +715,9 @@ abSelAttr = A.attrName "abselected"
 abMBarAttr :: A.AttrName
 abMBarAttr = A.attrName "menubar"
 
-scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
+scanZebra ::
-scanZebra dbP zHost zPort b eChan = do
+     T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
-  _ <- liftIO $ initDb dbP
+scanZebra dbP zHost zPort b eChan net = do
   bStatus <- liftIO $ checkBlockChain zHost zPort
   pool <- runNoLoggingT $ initPool dbP
   dbBlock <- runNoLoggingT $ getMaxBlock pool
@@ -772,7 +765,7 @@ scanZebra dbP zHost zPort b eChan = do
             Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
             Right hb -> do
               let blockTime = getBlockTime hb
-              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
+              mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
                 bl_txs $ addTime blk blockTime
               liftIO $ BC.writeBChan eChan $ TickVal step
     addTime :: BlockResponse -> Int -> BlockResponse
@@ -868,6 +861,7 @@ appEvent (BT.AppEvent t) = do
                       (s ^. zebraPort)
                       sBlock
                       (s ^. eventDispatch)
+                      (s ^. network)
                   BT.modify $ set timer 0
                   return ()
                 else BT.modify $ set timer $ 1 + s ^. timer
@@ -1369,75 +1363,82 @@ runZenithTUI config = do
       case bc of
         Left e1 -> throwIO e1
         Right chainInfo -> do
-          initDb dbFilePath
+          x <- initDb dbFilePath
-          walList <- getWallets pool $ zgb_net chainInfo
+          case x of
-          accList <-
+            Left e2 -> throwIO $ userError e2
-            if not (null walList)
+            Right x' -> do
-              then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
+              when x' $ rescanZebra host port dbFilePath
-              else return []
+              walList <- getWallets pool $ zgb_net chainInfo
-          addrList <-
+              accList <-
-            if not (null accList)
-              then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
-              else return []
-          txList <-
-            if not (null addrList)
-              then getUserTx pool $ entityKey $ head addrList
-              else return []
-          let block =
                 if not (null walList)
-                  then zcashWalletLastSync $ entityVal $ head walList
+                  then runNoLoggingT $
-                  else 0
+                       getAccounts pool $ entityKey $ head walList
-          abookList <- getAdrBook pool $ zgb_net chainInfo
+                  else return []
-          bal <-
+              addrList <-
-            if not (null accList)
+                if not (null accList)
-              then getBalance pool $ entityKey $ head accList
+                  then runNoLoggingT $
-              else return 0
+                       getAddresses pool $ entityKey $ head accList
-          uBal <-
+                  else return []
-            if not (null accList)
+              txList <-
-              then getUnconfirmedBalance pool $ entityKey $ head accList
+                if not (null addrList)
-              else return 0
+                  then getUserTx pool $ entityKey $ head addrList
-          eventChan <- BC.newBChan 10
+                  else return []
-          _ <-
+              let block =
-            forkIO $
+                    if not (null walList)
-            forever $ do
+                      then zcashWalletLastSync $ entityVal $ head walList
-              BC.writeBChan eventChan (TickVal 0.0)
+                      else 0
-              threadDelay 1000000
+              abookList <- getAdrBook pool $ zgb_net chainInfo
-          let buildVty = VC.mkVty V.defaultConfig
+              bal <-
-          initialVty <- buildVty
+                if not (null accList)
-          void $
+                  then getBalance pool $ entityKey $ head accList
-            M.customMain initialVty buildVty (Just eventChan) theApp $
+                  else return 0
-            State
+              uBal <-
-              (zgb_net chainInfo)
+                if not (null accList)
-              (L.list WList (Vec.fromList walList) 1)
+                  then getUnconfirmedBalance pool $ entityKey $ head accList
-              (L.list AcList (Vec.fromList accList) 0)
+                  else return 0
-              (L.list AList (Vec.fromList addrList) 1)
+              eventChan <- BC.newBChan 10
-              (L.list TList (Vec.fromList txList) 1)
+              _ <-
-              ("Start up Ok! Connected to Zebra " ++
+                forkIO $
-               (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
+                forever $ do
-              False
+                  BC.writeBChan eventChan (TickVal 0.0)
-              (if null walList
+                  threadDelay 1000000
-                 then WName
+              let buildVty = VC.mkVty V.defaultConfig
-                 else Blank)
+              initialVty <- buildVty
-              True
+              void $
-              (mkInputForm $ DialogInput "Main")
+                M.customMain initialVty buildVty (Just eventChan) theApp $
-              (F.focusRing [AList, TList])
+                State
-              (zgb_blocks chainInfo)
+                  (zgb_net chainInfo)
-              dbFilePath
+                  (L.list WList (Vec.fromList walList) 1)
-              host
+                  (L.list AcList (Vec.fromList accList) 0)
-              port
+                  (L.list AList (Vec.fromList addrList) 1)
-              MsgDisplay
+                  (L.list TList (Vec.fromList txList) 1)
-              block
+                  ("Start up Ok! Connected to Zebra " ++
-              bal
+                   (T.unpack . zgi_build) zebra ++
-              1.0
+                   " on port " ++ show port ++ ".")
-              eventChan
+                  False
-              0
+                  (if null walList
-              (mkSendForm 0 $ SendInput "" 0.0 "")
+                     then WName
-              (L.list ABList (Vec.fromList abookList) 1)
+                     else Blank)
-              (mkNewABForm (AdrBookEntry "" ""))
+                  True
-              ""
+                  (mkInputForm $ DialogInput "Main")
-              Nothing
+                  (F.focusRing [AList, TList])
-              uBal
+                  (zgb_blocks chainInfo)
-    Left e -> do
+                  dbFilePath
+                  host
+                  port
+                  MsgDisplay
+                  block
+                  bal
+                  1.0
+                  eventChan
+                  0
+                  (mkSendForm 0 $ SendInput "" 0.0 "")
+                  (L.list ABList (Vec.fromList abookList) 1)
+                  (mkNewABForm (AdrBookEntry "" ""))
+                  ""
+                  Nothing
+                  uBal
+    Left _e -> do
       print $
         "No Zebra node available on port " <>
         show port <> ". Check your configuration."

src/Zenith/Core.hs

@@ -728,48 +728,3 @@ syncWallet config w = do
   _ <- updateOrchardWitnesses pool
   _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
   mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
-
-testSync :: Config -> IO ()
-testSync config = do
-  let dbPath = c_dbPath config
-  _ <- initDb dbPath
-  pool <- runNoLoggingT $ initPool dbPath
-  w <- getWallets pool TestNet
-  r <- mapM (syncWallet config) w
-  liftIO $ print r
-  {-let uaRead =-}
-        {-isValidUnifiedAddress-}
-          {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
-  {-case uaRead of-}
-    {-Nothing -> print "wrong address"-}
-    {-Just ua -> do-}
-      {-startTime <- getCurrentTime-}
-      {-print startTime-}
-      {-tx <--}
-        {-prepareTx-}
-          {-"zenith.db"-}
-          {-"127.0.0.1"-}
-          {-18232-}
-          {-TestNet-}
-          {-(toSqlKey 1)-}
-          {-2820897-}
-          {-0.04-}
-          {-ua-}
-          {-"sent with Zenith, test"-}
-      {-print tx-}
-      {-endTime <- getCurrentTime-}
-      {-print endTime-}
-
-{-testSend :: IO ()-}
-{-testSend = do-}
-clearSync :: Config -> IO ()
-clearSync config = do
-  let dbPath = c_dbPath config
-  pool <- runNoLoggingT $ initPool dbPath
-  _ <- initDb dbPath
-  _ <- clearWalletTransactions pool
-  w <- getWallets pool TestNet
-  liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
-  w' <- liftIO $ getWallets pool TestNet
-  r <- mapM (syncWallet config) w'
-  liftIO $ print r

src/Zenith/DB.hs

@@ -18,12 +18,10 @@
 
 module Zenith.DB where
 
-import Control.Exception (throwIO)
+import Control.Exception (SomeException(..), throwIO, try)
-import Control.Monad (forM_, when)
+import Control.Monad (when)
-import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
-import Data.Aeson hiding (Key, Value)
-import Data.Bifunctor (bimap)
 import qualified Data.ByteString as BS
 import Data.HexString
 import Data.List (group, sort)
@@ -41,34 +39,29 @@ import Haskoin.Transaction.Common
   , TxOut(..)
   , txHashToHex
   )
-import qualified Lens.Micro as ML ((&), (.~), (^.))
+import System.Directory (doesFileExist, getHomeDirectory, removeFile)
+import System.FilePath ((</>))
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
   ( DecodedNote(..)
   , OrchardAction(..)
   , OrchardBundle(..)
-  , OrchardSpendingKey(..)
   , OrchardWitness(..)
   , SaplingBundle(..)
-  , SaplingCommitmentTree(..)
-  , SaplingSpendingKey(..)
   , SaplingWitness(..)
   , Scope(..)
   , ShieldedOutput(..)
   , ShieldedSpend(..)
   , ToBytes(..)
   , Transaction(..)
-  , TransparentAddress(..)
   , TransparentBundle(..)
   , TransparentReceiver(..)
   , UnifiedAddress(..)
   , ZcashNet(..)
-  , decodeHexText
   )
 import Zenith.Types
-  ( Config(..)
+  ( HexStringDB(..)
-  , HexStringDB(..)
   , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
   , RseedDB(..)
@@ -197,7 +190,8 @@ share
     txId HexStringDB
     conf Int
     time Int
-    UniqueTx block txId
+    network ZcashNetDB
+    UniqueTx block txId network
     deriving Show Eq
   TransparentNote
     tx ZcashTransactionId
@@ -311,9 +305,53 @@ toZcashAddressAPI a =
 -- | Initializes the database
 initDb ::
      T.Text -- ^ The database path to check
-  -> IO ()
+  -> IO (Either String Bool)
 initDb dbName = do
-  PS.runSqlite dbName $ do runMigration migrateAll
+  print "Start database"
+  j <-
+    try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
+      (Either SomeException [T.Text])
+  case j of
+    Left e1 -> do
+      print e1
+      pool <- runNoLoggingT $ initPool dbName
+      wallets <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do select . from $ table @ZcashWallet
+      accounts <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do select . from $ table @ZcashAccount
+      abook <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do select . from $ table @AddressBook
+      hDir <- getHomeDirectory
+      let backupDb = hDir </> "Zenith/.backup.db"
+      checkDbFile <- doesFileExist backupDb
+      when checkDbFile $ removeFile backupDb
+      _ <- PS.runSqlite (T.pack backupDb) $ runMigrationQuiet migrateAll
+      backupPool <- runNoLoggingT $ initPool $ T.pack backupDb
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> wallets
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> accounts
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> abook
+      m <-
+        try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
+          (Either SomeException [T.Text])
+      case m of
+        Left _e2 -> return $ Left "Failed to migrate data tables"
+        Right _ -> return $ Right True
+    Right _ -> return $ Right False
 
 initPool :: T.Text -> NoLoggingT IO ConnectionPool
 initPool dbPath = do
@@ -519,15 +557,16 @@ saveAddress pool w =
 saveTransaction ::
      ConnectionPool -- ^ the database path
   -> Int -- ^ block time
+  -> ZcashNetDB -- ^ the network
   -> Transaction -- ^ The transaction to save
   -> NoLoggingT IO (Key ZcashTransaction)
-saveTransaction pool t wt =
+saveTransaction pool t n wt =
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     let ix = [0 ..]
     w <-
       insert $
-      ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
+      ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
     when (isJust $ tx_transpBundle wt) $ do
       _ <-
         insertMany_ $
@@ -1499,6 +1538,32 @@ clearWalletTransactions pool = do
       delete $ do
         _ <- from $ table @WalletTransaction
         return ()
+      update $ \w -> do
+        set w [ZcashWalletLastSync =. val 0]
+
+clearWalletData :: ConnectionPool -> IO ()
+clearWalletData pool = do
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      delete $ do
+        _ <- from $ table @TransparentNote
+        return ()
+      delete $ do
+        _ <- from $ table @TransparentSpend
+        return ()
+      delete $ do
+        _ <- from $ table @OrchAction
+        return ()
+      delete $ do
+        _ <- from $ table @ShieldOutput
+        return ()
+      delete $ do
+        _ <- from $ table @ShieldSpend
+        return ()
+      delete $ do
+        _ <- from $ table @ZcashTransaction
+        return ()
 
 getWalletUnspentTrNotes ::
      ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]

src/Zenith/GUI.hs

@@ -9,13 +9,13 @@ import Codec.QRCode
 import Codec.QRCode.JuicyPixels
 import Control.Concurrent (threadDelay)
 import Control.Exception (throwIO, try)
+import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
 import Data.Aeson
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LBS
 import Data.HexString (toText)
-import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@@ -27,7 +27,6 @@ import Monomer
 import qualified Monomer.Lens as L
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
-import System.Hclip
 import Text.Printf
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import TextShow hiding (toText)
@@ -36,7 +35,6 @@ import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
   ( BlockResponse(..)
-  , Phrase(..)
   , Scope(..)
   , ToBytes(..)
   , UnifiedAddress(..)
@@ -48,7 +46,7 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
 import Zenith.GUI.Theme
-import Zenith.Scanner (processTx, updateConfs)
+import Zenith.Scanner (processTx, rescanZebra, updateConfs)
 import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
@@ -1030,6 +1028,7 @@ handleEvent wenv node model evt =
                         (c_dbPath $ model ^. configuration)
                         (c_zebraHost $ model ^. configuration)
                         (c_zebraPort $ model ^. configuration)
+                        (model ^. network)
                     ]
                else [Model $ model & timer .~ 0]
     SyncVal i ->
@@ -1147,9 +1146,8 @@ handleEvent wenv node model evt =
               wL <- getWallets pool (model ^. network)
               return $ LoadWallets wL
 
-scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO ()
+scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
-scanZebra dbPath zHost zPort sendMsg = do
+scanZebra dbPath zHost zPort net sendMsg = do
-  _ <- liftIO $ initDb dbPath
   bStatus <- liftIO $ checkBlockChain zHost zPort
   pool <- runNoLoggingT $ initPool dbPath
   b <- liftIO $ getMinBirthdayHeight pool
@@ -1192,7 +1190,7 @@ scanZebra dbPath zHost zPort sendMsg = do
             Left e2 -> sendMsg (ShowError $ showt e2)
             Right hb -> do
               let blockTime = getBlockTime hb
-              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
+              mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
                 bl_txs $ addTime blk blockTime
               sendMsg (SyncVal step)
     addTime :: BlockResponse -> Int -> BlockResponse
@@ -1267,128 +1265,87 @@ runZenithGUI config = do
           case bc of
             Left e1 -> throwIO e1
             Right chainInfo -> do
-              initDb dbFilePath
+              x <- initDb dbFilePath
-              generateQRCodes config
+              case x of
-              walList <- getWallets pool $ zgb_net chainInfo
+                Left e2 -> throwIO $ userError e2
-              accList <-
+                Right x' -> do
-                if not (null walList)
+                  when x' $ rescanZebra host port dbFilePath
-                  then runNoLoggingT $
+                  generateQRCodes config
-                       getAccounts pool $ entityKey $ head walList
+                  walList <- getWallets pool $ zgb_net chainInfo
-                  else return []
+                  accList <-
-              addrList <-
+                    if not (null walList)
-                if not (null accList)
+                      then runNoLoggingT $
-                  then runNoLoggingT $
+                           getAccounts pool $ entityKey $ head walList
-                       getAddresses pool $ entityKey $ head accList
+                      else return []
-                  else return []
+                  addrList <-
-              txList <-
+                    if not (null accList)
-                if not (null addrList)
+                      then runNoLoggingT $
-                  then getUserTx pool $ entityKey $ head addrList
+                           getAddresses pool $ entityKey $ head accList
-                  else return []
+                      else return []
-              qr <-
+                  txList <-
-                if not (null addrList)
+                    if not (null addrList)
-                  then getQrCode pool Orchard $ entityKey $ head addrList
+                      then getUserTx pool $ entityKey $ head addrList
-                  else return Nothing
+                      else return []
-              bal <-
+                  qr <-
-                if not (null accList)
+                    if not (null addrList)
-                  then getBalance pool $ entityKey $ head accList
+                      then getQrCode pool Orchard $ entityKey $ head addrList
-                  else return 0
+                      else return Nothing
-              unconfBal <-
+                  bal <-
-                if not (null accList)
+                    if not (null accList)
-                  then getUnconfirmedBalance pool $ entityKey $ head accList
+                      then getBalance pool $ entityKey $ head accList
-                  else return 0
+                      else return 0
-              let model =
+                  unconfBal <-
-                    AppModel
+                    if not (null accList)
-                      config
+                      then getUnconfirmedBalance pool $ entityKey $ head accList
-                      (zgb_net chainInfo)
+                      else return 0
-                      walList
+                  let model =
-                      0
+                        AppModel
-                      accList
+                          config
-                      0
+                          (zgb_net chainInfo)
-                      addrList
+                          walList
-                      0
+                          0
-                      txList
+                          accList
-                      0
+                          0
-                      Nothing
+                          addrList
-                      True
+                          0
-                      bal
+                          txList
-                      (if unconfBal == 0
+                          0
-                         then Nothing
+                          Nothing
-                         else Just unconfBal)
+                          True
-                      Orchard
+                          bal
-                      qr
+                          (if unconfBal == 0
-                      False
+                             then Nothing
-                      False
+                             else Just unconfBal)
-                      False
+                          Orchard
-                      False
+                          qr
-                      ""
+                          False
-                      Nothing
+                          False
-                      ""
+                          False
-                      ""
+                          False
-                      (SaveAddress $
+                          ""
-                       if not (null accList)
+                          Nothing
-                         then Just (head accList)
+                          ""
-                         else Nothing)
+                          ""
-                      False
+                          (SaveAddress $
-                      False
+                           if not (null accList)
-                      Nothing
+                             then Just (head accList)
-                      Nothing
+                             else Nothing)
-                      0
+                          False
-                      1.0
+                          False
-                      False
+                          Nothing
-                      ""
+                          Nothing
-                      0.0
+                          0
-                      ""
+                          1.0
-                      False
+                          False
-                      False
+                          ""
-                      Nothing
+                          0.0
-                      hD
+                          ""
-              startApp model handleEvent buildUI (params hD)
+                          False
-        Left e -> do
+                          False
-          initDb dbFilePath
+                          Nothing
-          let model =
+                          hD
-                AppModel
+                  startApp model handleEvent buildUI (params hD)
-                  config
+        Left _e -> print "Zebra not available"
-                  TestNet
-                  []
-                  0
-                  []
-                  0
-                  []
-                  0
-                  []
-                  0
-                  (Just $
-                   "Couldn't connect to Zebra on " <>
-                   host <> ":" <> showt port <> ". Check your configuration.")
-                  False
-                  314259000
-                  (Just 30000)
-                  Orchard
-                  Nothing
-                  False
-                  False
-                  False
-                  False
-                  ""
-                  Nothing
-                  ""
-                  ""
-                  (SaveAddress Nothing)
-                  False
-                  False
-                  Nothing
-                  Nothing
-                  0
-                  1.0
-                  False
-                  ""
-                  0.0
-                  ""
-                  False
-                  False
-                  Nothing
-                  hD
-          startApp model handleEvent buildUI (params hD)
   where
     params hd =
       [ appWindowTitle "Zenith - Zcash Full Node Wallet"

src/Zenith/RPC.hs

@@ -40,6 +40,7 @@ import Zenith.Types
   ( Config(..)
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
+  , ZcashNoteAPI(..)
   , ZcashWalletAPI(..)
   )
 import Zenith.Utils (jsonNumber)
@@ -49,6 +50,7 @@ data ZenithMethod
   | ListWallets
   | ListAccounts
   | ListAddresses
+  | ListReceived
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -57,6 +59,7 @@ instance ToJSON ZenithMethod where
   toJSON ListWallets = Data.Aeson.String "listwallets"
   toJSON ListAccounts = Data.Aeson.String "listaccounts"
   toJSON ListAddresses = Data.Aeson.String "listaddresses"
+  toJSON ListReceived = Data.Aeson.String "listreceived"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -66,6 +69,7 @@ instance FromJSON ZenithMethod where
       "listwallets" -> pure ListWallets
       "listaccounts" -> pure ListAccounts
       "listaddresses" -> pure ListAddresses
+      "listreceived" -> pure ListReceived
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -73,6 +77,7 @@ data ZenithParams
   | BadParams
   | AccountsParams !Int
   | AddressesParams !Int
+  | NotesParams !T.Text
   | TestParams !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -82,24 +87,23 @@ instance ToJSON ZenithParams where
   toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
   toJSON (AddressesParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
   toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
+  toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
 
 data ZenithResponse
   = InfoResponse !T.Text !ZenithInfo
   | WalletListResponse !T.Text ![ZcashWalletAPI]
   | AccountListResponse !T.Text ![ZcashAccountAPI]
   | AddressListResponse !T.Text ![ZcashAddressAPI]
+  | NoteListResponse !T.Text ![ZcashNoteAPI]
   | ErrorResponse !T.Text !Double !T.Text
   deriving (Eq, Prelude.Show)
 
 instance ToJSON ZenithResponse where
-  toJSON (InfoResponse t i) =
+  toJSON (InfoResponse t i) = packRpcResponse t i
-    object ["jsonrpc" .= ("2.0" :: String), "id" .= t, "result" .= i]
+  toJSON (WalletListResponse i w) = packRpcResponse i w
-  toJSON (WalletListResponse i w) =
+  toJSON (AccountListResponse i a) = packRpcResponse i a
-    object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= w]
+  toJSON (AddressListResponse i a) = packRpcResponse i a
-  toJSON (AccountListResponse i a) =
+  toJSON (NoteListResponse i n) = packRpcResponse i n
-    object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a]
-  toJSON (AddressListResponse i a) =
-    object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a]
   toJSON (ErrorResponse i c m) =
     object
       [ "jsonrpc" .= ("2.0" :: String)
@@ -109,7 +113,7 @@ instance ToJSON ZenithResponse where
 
 instance FromJSON ZenithResponse where
   parseJSON =
-    withObject "ZenithParams" $ \obj -> do
+    withObject "ZenithResponse" $ \obj -> do
       jr <- obj .: "jsonrpc"
       i <- obj .: "id"
       e <- obj .:? "error"
@@ -138,6 +142,7 @@ instance FromJSON ZenithResponse where
                             Object n' -> do
                               v1 <- n' .:? "lastSync"
                               v2 <- n' .:? "wallet"
+                              v3 <- n' .:? "ua"
                               case (v1 :: Maybe Int) of
                                 Just _v1' -> do
                                   k2 <- parseJSON r1
@@ -147,7 +152,12 @@ instance FromJSON ZenithResponse where
                                     Just _v2' -> do
                                       k3 <- parseJSON r1
                                       pure $ AccountListResponse i k3
-                                    Nothing -> fail "Unknown object"
+                                    Nothing ->
+                                      case (v3 :: Maybe String) of
+                                        Just _v3' -> do
+                                          k4 <- parseJSON r1
+                                          pure $ AddressListResponse i k4
+                                        Nothing -> fail "Unknown object"
                             _anyOther -> fail "Malformed JSON"
                     _anyOther -> fail "Malformed JSON"
             Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
@@ -220,6 +230,16 @@ instance FromJSON RpcCall where
                   pure $ RpcCall v i ListAddresses (AddressesParams x)
                 else pure $ RpcCall v i ListAddresses BadParams
             _anyOther -> pure $ RpcCall v i ListAddresses BadParams
+        ListReceived -> do
+          p <- obj .: "params"
+          case p of
+            Array a ->
+              if V.length a == 1
+                then do
+                  x <- parseJSON $ V.head a
+                  pure $ RpcCall v i ListReceived (NotesParams x)
+                else pure $ RpcCall v i ListReceived BadParams
+            _anyOther -> pure $ RpcCall v i ListReceived BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@@ -336,6 +356,11 @@ zenithServer config = getinfo :<|> handleRPC
                         (ZenithInfo "0.7.0.0-beta" (zgb_net bI) (zgi_build zI))
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
+        ListReceived ->
+          case parameters req of
+            NotesParams x -> undefined
+            _anyOtherParams ->
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
 
 authenticate :: Config -> BasicAuthCheck Bool
 authenticate config = BasicAuthCheck check
@@ -344,3 +369,7 @@ authenticate config = BasicAuthCheck check
       if username == c_zenithUser config && password == c_zenithPwd config
         then return $ Authorized True
         else return Unauthorized
+
+packRpcResponse :: ToJSON a => T.Text -> a -> Value
+packRpcResponse i x =
+  object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]

src/Zenith/Scanner.hs

@@ -2,29 +2,22 @@
 
 module Zenith.Scanner where
 
+import Control.Concurrent.Async (concurrently_, withAsync)
 import Control.Exception (throwIO, try)
-import qualified Control.Monad.Catch as CM (try)
+import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger
+import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
-  ( LoggingT
-  , NoLoggingT
-  , logErrorN
-  , logInfoN
-  , runNoLoggingT
-  )
 import Data.Aeson
 import Data.HexString
-import Data.Maybe
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
 import Database.Persist.Sqlite
-import GHC.Utils.Monad (concatMapM)
-import Lens.Micro ((&), (.~), (^.), set)
 import System.Console.AsciiProgress
 import ZcashHaskell.Types
   ( BlockResponse(..)
   , RawZebraTx(..)
   , Transaction(..)
+  , ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
   , ZebraTxResponse(..)
   , fromRawOBundle
@@ -32,59 +25,68 @@ import ZcashHaskell.Types
   , fromRawTBundle
   )
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
-import Zenith.Core (checkBlockChain)
+import Zenith.Core (checkBlockChain, syncWallet)
 import Zenith.DB
-  ( getMaxBlock
+  ( clearWalletData
+  , clearWalletTransactions
+  , getMaxBlock
+  , getMinBirthdayHeight
   , getUnconfirmedBlocks
+  , getWallets
   , initDb
+  , initPool
   , saveConfs
   , saveTransaction
+  , updateWalletSync
   )
+import Zenith.Types (Config(..), ZcashNetDB(..))
 import Zenith.Utils (jsonNumber)
 
 -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
-scanZebra ::
+rescanZebra ::
-     Int -- ^ Starting block
+     T.Text -- ^ Host
-  -> T.Text -- ^ Host
   -> Int -- ^ Port
   -> T.Text -- ^ Path to database file
-  -> NoLoggingT IO ()
+  -> IO ()
-scanZebra b host port dbFilePath = do
+rescanZebra host port dbFilePath = do
-  _ <- liftIO $ initDb dbFilePath
-  startTime <- liftIO getCurrentTime
-  logInfoN $ "Started sync: " <> T.pack (show startTime)
   bc <-
-    liftIO $ try $ checkBlockChain host port :: NoLoggingT
+    try $ checkBlockChain host port :: IO
-      IO
       (Either IOError ZebraGetBlockChainInfo)
   case bc of
-    Left e -> logErrorN $ T.pack (show e)
+    Left e -> print e
     Right bStatus -> do
-      let dbInfo =
+      let znet = ZcashNetDB $ zgb_net bStatus
-            mkSqliteConnectionInfo dbFilePath & extraPragmas .~
+      pool1 <- runNoLoggingT $ initPool dbFilePath
-            ["read_uncommited = true"]
+      pool2 <- runNoLoggingT $ initPool dbFilePath
-      pool <- createSqlitePoolFromInfo dbInfo 5
+      pool3 <- runNoLoggingT $ initPool dbFilePath
-      dbBlock <- getMaxBlock pool
+      clearWalletTransactions pool1
+      clearWalletData pool1
+      dbBlock <- runNoLoggingT $ getMaxBlock pool1
+      b <- liftIO $ getMinBirthdayHeight pool1
       let sb = max dbBlock b
       if sb > zgb_blocks bStatus || sb < 1
         then liftIO $ throwIO $ userError "Invalid starting block for scan"
         else do
-          liftIO $
+          print $
-            print $
+            "Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
-            "Scanning from " ++
+          let bList = [sb .. (zgb_blocks bStatus)]
-            show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
+          {-
-          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+          let batch = length bList `div` 3
-          displayConsoleRegions $ do
+          let bl1 = take batch bList
-            pg <-
+          let bl2 = take batch $ drop batch bList
-              liftIO $
+          let bl3 = drop (2 * batch) bList
-              newProgressBar def {pgTotal = fromIntegral $ length bList}
+          -}
-            txList <-
+          _ <-
-              CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
+            displayConsoleRegions $ do
-                IO
+              pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
-                (Either IOError ())
+              {-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
-            case txList of
+              {-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
-              Left e1 -> logErrorN $ T.pack (show e1)
+              mapM_ (processBlock host port pool1 pg1 znet) bList
-              Right txList' -> logInfoN "Finished scan"
+              {-`concurrently_`-}
+                {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
+                {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
+              print "Please wait..."
+          print "Rescan complete"
 
 -- | Function to process a raw block and extract the transaction information
 processBlock ::
@@ -92,9 +94,10 @@ processBlock ::
   -> Int -- ^ Port for `zebrad`
   -> ConnectionPool -- ^ DB file path
   -> ProgressBar -- ^ Progress bar
+  -> ZcashNetDB -- ^ the network
   -> Int -- ^ The block number to process
-  -> NoLoggingT IO ()
+  -> IO ()
-processBlock host port pool pg b = do
+processBlock host port pool pg net b = do
   r <-
     liftIO $
     makeZebraCall
@@ -116,7 +119,7 @@ processBlock host port pool pg b = do
         Left e2 -> liftIO $ throwIO $ userError e2
         Right hb -> do
           let blockTime = getBlockTime hb
-          mapM_ (processTx host port blockTime pool) $
+          mapM_ (processTx host port blockTime pool net) $
             bl_txs $ addTime blk blockTime
           liftIO $ tick pg
   where
@@ -134,9 +137,10 @@ processTx ::
   -> Int -- ^ Port for `zebrad`
   -> Int -- ^ Block time
   -> ConnectionPool -- ^ DB file path
+  -> ZcashNetDB -- ^ the network
   -> HexString -- ^ transaction id
-  -> NoLoggingT IO ()
+  -> IO ()
-processTx host port bt pool t = do
+processTx host port bt pool net t = do
   r <-
     liftIO $
     makeZebraCall
@@ -151,7 +155,8 @@ processTx host port bt pool t = do
         Nothing -> return ()
         Just rzt -> do
           _ <-
-            saveTransaction pool bt $
+            runNoLoggingT $
+            saveTransaction pool bt net $
             Transaction
               t
               (ztr_blockheight rawTx)
@@ -184,3 +189,27 @@ updateConfs host port pool = do
         Left e -> throwIO $ userError e
         Right blk -> do
           saveConfs pool b $ fromInteger $ bl_confirmations blk
+
+clearSync :: Config -> IO ()
+clearSync config = do
+  let zHost = c_zebraHost config
+  let zPort = c_zebraPort config
+  let dbPath = c_dbPath config
+  pool <- runNoLoggingT $ initPool dbPath
+  bc <-
+    try $ checkBlockChain zHost zPort :: IO
+      (Either IOError ZebraGetBlockChainInfo)
+  case bc of
+    Left e1 -> throwIO e1
+    Right chainInfo -> do
+      x <- initDb dbPath
+      case x of
+        Left e2 -> throwIO $ userError e2
+        Right x' -> do
+          when x' $ rescanZebra zHost zPort dbPath
+          _ <- clearWalletTransactions pool
+          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'
+          liftIO $ print r

zenith-openrpc.json

@@ -320,7 +320,7 @@
       "Address": {
         "name": "Address identifier",
         "summary": "The address identifier",
-        "description": "A string that identifies a specific address, either by its index or the address itself",
+        "description": "A string that identifies a specific address, either by its index or the [ZIP-316](https://zips.z.cash/zip-0316) encoded address itself",
         "required": true,
         "schema": {
           "type": "string"

zenith.cabal

@@ -42,6 +42,7 @@ library
       Clipboard
     , aeson
     , array
+    , async
     , ascii-progress
     , base >=4.12 && <5
     , base64-bytestring
@@ -113,19 +114,6 @@ executable zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
-executable zenscan
-  ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
-  main-is: ZenScan.hs
-  hs-source-dirs:
-    app
-  build-depends:
-      base >=4.12 && <5
-    , configurator
-    , monad-logger
-    , zenith
-  pkgconfig-depends: rustzcash_wrapper
-  default-language: Haskell2010
-
 executable zenithserver
   ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
   main-is: Server.hs
@@ -137,6 +125,7 @@ executable zenithserver
     , wai-extra
     , warp
     , servant-server
+    , zcash-haskell
     , zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010