From 46b4969da553cabb9956b6d24c1d6e1f5f06c8a5 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Sat, 10 Aug 2024 07:04:40 -0500 Subject: [PATCH] Implement database migration --- app/Main.hs | 4 +- app/Server.hs | 27 +++++- app/ZenScan.hs | 2 +- src/Zenith/CLI.hs | 173 ++++++++++++++++----------------- src/Zenith/Core.hs | 45 --------- src/Zenith/DB.hs | 101 +++++++++++++++---- src/Zenith/GUI.hs | 219 +++++++++++++++++------------------------- src/Zenith/RPC.hs | 49 ++++++++-- src/Zenith/Scanner.hs | 131 +++++++++++++++---------- zenith-openrpc.json | 2 +- zenith.cabal | 15 +-- 11 files changed, 408 insertions(+), 360 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 3faa6eb..03b3089 100644 --- a/app/Main.hs +++ b/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 diff --git a/app/Server.hs b/app/Server.hs index 05db7fe..af5bf4a 100644 --- a/app/Server.hs +++ b/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 $ - serveWithContext (Proxy :: Proxy ZenithRPC) ctx (zenithServer myConfig) + w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo) + 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) diff --git a/app/ZenScan.hs b/app/ZenScan.hs index 05059ca..24b09fe 100644 --- a/app/ZenScan.hs +++ b/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 diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index fe04a21..51389bd 100644 --- a/src/Zenith/CLI.hs +++ b/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.Monad (forever, void) +import Control.Exception (throw, throwIO, try) +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 ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) +import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..)) +import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) -import ZcashHaskell.Transparent - ( decodeTransparentAddress - , encodeTransparentReceiver - ) +import ZcashHaskell.Transparent (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 dbP zHost zPort b eChan = do - _ <- liftIO $ initDb dbP +scanZebra :: + T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO () +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 - walList <- getWallets pool $ zgb_net chainInfo - accList <- - if not (null walList) - then runNoLoggingT $ getAccounts pool $ entityKey $ head walList - else return [] - addrList <- - 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 = + x <- initDb dbFilePath + case x of + Left e2 -> throwIO $ userError e2 + Right x' -> do + when x' $ rescanZebra host port dbFilePath + walList <- getWallets pool $ zgb_net chainInfo + accList <- if not (null walList) - then zcashWalletLastSync $ entityVal $ head walList - else 0 - abookList <- getAdrBook pool $ zgb_net chainInfo - bal <- - if not (null accList) - then getBalance pool $ entityKey $ head accList - else return 0 - uBal <- - if not (null accList) - then getUnconfirmedBalance pool $ entityKey $ head accList - else return 0 - eventChan <- BC.newBChan 10 - _ <- - forkIO $ - forever $ do - BC.writeBChan eventChan (TickVal 0.0) - threadDelay 1000000 - let buildVty = VC.mkVty V.defaultConfig - initialVty <- buildVty - void $ - M.customMain initialVty buildVty (Just eventChan) theApp $ - State - (zgb_net chainInfo) - (L.list WList (Vec.fromList walList) 1) - (L.list AcList (Vec.fromList accList) 0) - (L.list AList (Vec.fromList addrList) 1) - (L.list TList (Vec.fromList txList) 1) - ("Start up Ok! Connected to Zebra " ++ - (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") - False - (if null walList - then WName - else Blank) - True - (mkInputForm $ DialogInput "Main") - (F.focusRing [AList, TList]) - (zgb_blocks chainInfo) - 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 + then runNoLoggingT $ + getAccounts pool $ entityKey $ head walList + else return [] + addrList <- + 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 + else 0 + abookList <- getAdrBook pool $ zgb_net chainInfo + bal <- + if not (null accList) + then getBalance pool $ entityKey $ head accList + else return 0 + uBal <- + if not (null accList) + then getUnconfirmedBalance pool $ entityKey $ head accList + else return 0 + eventChan <- BC.newBChan 10 + _ <- + forkIO $ + forever $ do + BC.writeBChan eventChan (TickVal 0.0) + threadDelay 1000000 + let buildVty = VC.mkVty V.defaultConfig + initialVty <- buildVty + void $ + M.customMain initialVty buildVty (Just eventChan) theApp $ + State + (zgb_net chainInfo) + (L.list WList (Vec.fromList walList) 1) + (L.list AcList (Vec.fromList accList) 0) + (L.list AList (Vec.fromList addrList) 1) + (L.list TList (Vec.fromList txList) 1) + ("Start up Ok! Connected to Zebra " ++ + (T.unpack . zgi_build) zebra ++ + " on port " ++ show port ++ ".") + False + (if null walList + then WName + else Blank) + True + (mkInputForm $ DialogInput "Main") + (F.focusRing [AList, TList]) + (zgb_blocks chainInfo) + 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." diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index abfb476..61a74d4 100644 --- a/src/Zenith/Core.hs +++ b/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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 3d2f966..3446b9f 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -18,12 +18,10 @@ module Zenith.DB where -import Control.Exception (throwIO) -import Control.Monad (forM_, when) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Exception (SomeException(..), throwIO, try) +import Control.Monad (when) +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] diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 70b8fd7..aac7955 100644 --- a/src/Zenith/GUI.hs +++ b/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 dbPath zHost zPort sendMsg = do - _ <- liftIO $ initDb dbPath +scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO () +scanZebra dbPath zHost zPort net sendMsg = do 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 - generateQRCodes config - walList <- getWallets pool $ zgb_net chainInfo - accList <- - if not (null walList) - then runNoLoggingT $ - getAccounts pool $ entityKey $ head walList - else return [] - addrList <- - 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 [] - qr <- - if not (null addrList) - then getQrCode pool Orchard $ entityKey $ head addrList - else return Nothing - bal <- - if not (null accList) - then getBalance pool $ entityKey $ head accList - else return 0 - unconfBal <- - if not (null accList) - then getUnconfirmedBalance pool $ entityKey $ head accList - else return 0 - let model = - AppModel - config - (zgb_net chainInfo) - walList - 0 - accList - 0 - addrList - 0 - txList - 0 - Nothing - True - bal - (if unconfBal == 0 - then Nothing - else Just unconfBal) - Orchard - qr - False - False - False - False - "" - Nothing - "" - "" - (SaveAddress $ - if not (null accList) - then Just (head accList) - else Nothing) - False - False - Nothing - Nothing - 0 - 1.0 - False - "" - 0.0 - "" - False - False - Nothing - hD - startApp model handleEvent buildUI (params hD) - Left e -> do - initDb dbFilePath - let model = - AppModel - config - 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) + x <- initDb dbFilePath + case x of + Left e2 -> throwIO $ userError e2 + Right x' -> do + when x' $ rescanZebra host port dbFilePath + generateQRCodes config + walList <- getWallets pool $ zgb_net chainInfo + accList <- + if not (null walList) + then runNoLoggingT $ + getAccounts pool $ entityKey $ head walList + else return [] + addrList <- + 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 [] + qr <- + if not (null addrList) + then getQrCode pool Orchard $ entityKey $ head addrList + else return Nothing + bal <- + if not (null accList) + then getBalance pool $ entityKey $ head accList + else return 0 + unconfBal <- + if not (null accList) + then getUnconfirmedBalance pool $ entityKey $ head accList + else return 0 + let model = + AppModel + config + (zgb_net chainInfo) + walList + 0 + accList + 0 + addrList + 0 + txList + 0 + Nothing + True + bal + (if unconfBal == 0 + then Nothing + else Just unconfBal) + Orchard + qr + False + False + False + False + "" + Nothing + "" + "" + (SaveAddress $ + if not (null accList) + then Just (head accList) + else Nothing) + False + False + Nothing + Nothing + 0 + 1.0 + False + "" + 0.0 + "" + False + False + Nothing + hD + startApp model handleEvent buildUI (params hD) + Left _e -> print "Zebra not available" where params hd = [ appWindowTitle "Zenith - Zcash Full Node Wallet" diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index 8dc2cba..3df1d4b 100644 --- a/src/Zenith/RPC.hs +++ b/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) = - object ["jsonrpc" .= ("2.0" :: String), "id" .= t, "result" .= i] - toJSON (WalletListResponse i w) = - object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= w] - toJSON (AccountListResponse i a) = - object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a] - toJSON (AddressListResponse i a) = - object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a] + toJSON (InfoResponse t i) = packRpcResponse t i + toJSON (WalletListResponse i w) = packRpcResponse i w + toJSON (AccountListResponse i a) = packRpcResponse i a + toJSON (AddressListResponse i a) = packRpcResponse i a + toJSON (NoteListResponse i n) = packRpcResponse i n 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] diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index 09f7ccc..0149890 100644 --- a/src/Zenith/Scanner.hs +++ b/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 - ( LoggingT - , NoLoggingT - , logErrorN - , logInfoN - , runNoLoggingT - ) +import Control.Monad.Logger (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 :: - Int -- ^ Starting block - -> T.Text -- ^ Host +rescanZebra :: + T.Text -- ^ Host -> Int -- ^ Port -> T.Text -- ^ Path to database file - -> NoLoggingT IO () -scanZebra b host port dbFilePath = do - _ <- liftIO $ initDb dbFilePath - startTime <- liftIO getCurrentTime - logInfoN $ "Started sync: " <> T.pack (show startTime) + -> IO () +rescanZebra host port dbFilePath = do bc <- - liftIO $ try $ checkBlockChain host port :: NoLoggingT - IO + try $ checkBlockChain host port :: IO (Either IOError ZebraGetBlockChainInfo) case bc of - Left e -> logErrorN $ T.pack (show e) + Left e -> print e Right bStatus -> do - let dbInfo = - mkSqliteConnectionInfo dbFilePath & extraPragmas .~ - ["read_uncommited = true"] - pool <- createSqlitePoolFromInfo dbInfo 5 - dbBlock <- getMaxBlock pool + let znet = ZcashNetDB $ zgb_net bStatus + pool1 <- runNoLoggingT $ initPool dbFilePath + pool2 <- runNoLoggingT $ initPool dbFilePath + pool3 <- runNoLoggingT $ initPool dbFilePath + 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 $ - "Scanning from " ++ - show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus) - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - displayConsoleRegions $ do - pg <- - liftIO $ - newProgressBar def {pgTotal = fromIntegral $ length bList} - txList <- - CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT - IO - (Either IOError ()) - case txList of - Left e1 -> logErrorN $ T.pack (show e1) - Right txList' -> logInfoN "Finished scan" + print $ + "Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus) + let bList = [sb .. (zgb_blocks bStatus)] + {- + let batch = length bList `div` 3 + let bl1 = take batch bList + let bl2 = take batch $ drop batch bList + let bl3 = drop (2 * batch) bList + -} + _ <- + displayConsoleRegions $ do + pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList} + {-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-} + {-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-} + mapM_ (processBlock host port pool1 pg1 znet) bList + {-`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 () -processBlock host port pool pg b = do + -> IO () +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 () -processTx host port bt pool t = do + -> IO () +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 diff --git a/zenith-openrpc.json b/zenith-openrpc.json index abfd0bd..6c1778b 100644 --- a/zenith-openrpc.json +++ b/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" diff --git a/zenith.cabal b/zenith.cabal index 37a537c..af39c96 100644 --- a/zenith.cabal +++ b/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