From de211d03b0c7e9a012c8cc36b346ff6aa998e306 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 22 Mar 2024 20:39:37 +0000 Subject: [PATCH] Add Zenith Scanner (#71) Reviewed-on: https://git.vergara.tech/Vergara_Tech/zenith/pulls/71 Co-authored-by: Rene Vergara Co-committed-by: Rene Vergara --- app/ZenScan.hs | 15 +++++++++++ src/Zenith/CLI.hs | 45 ++++++++++++++++++++++--------- src/Zenith/Core.hs | 25 +++++++---------- src/Zenith/DB.hs | 51 ++++++++++++++++++++++++++++++++++- src/Zenith/Scanner.hs | 62 +++++++++++++++++++++++++++++++++++++++++++ src/Zenith/Types.hs | 37 +++++++------------------- src/Zenith/Utils.hs | 9 ++++--- src/Zenith/Zcashd.hs | 43 +++++++++++++++++++----------- zcash-haskell | 2 +- zenith.cabal | 16 ++++++++++- zenith.cfg | 1 + 11 files changed, 231 insertions(+), 75 deletions(-) create mode 100644 app/ZenScan.hs create mode 100644 src/Zenith/Scanner.hs diff --git a/app/ZenScan.hs b/app/ZenScan.hs new file mode 100644 index 0000000..a2c23d5 --- /dev/null +++ b/app/ZenScan.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ZenScan where + +import Data.Configurator +import Zenith.Scanner (scanZebra) + +main :: IO () +main = do + config <- load ["zenith.cfg"] + dbFilePath <- require config "dbFilePath" + {-dataStorePath <- require config "dataStorePath"-} + zebraPort <- require config "zebraPort" + zebraHost <- require config "zebraHost" + scanZebra 2764500 zebraHost zebraPort dbFilePath diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 8855d4e..c25eb69 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -1,5 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Zenith.CLI where @@ -45,7 +47,7 @@ import Brick.Widgets.Core ) import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.List as L -import Control.Exception (throw, throwIO, try) +import Control.Exception (catch, throw, throwIO, try) import Control.Monad (void) import Control.Monad.IO.Class (liftIO) import Data.Maybe @@ -59,6 +61,8 @@ import Lens.Micro.Mtl import Lens.Micro.TH import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) +import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Transparent (encodeTransparent) import ZcashHaskell.Types import Zenith.Core import Zenith.DB @@ -270,8 +274,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] Nothing 60) (padAll 1 $ - txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - getUA $ walletAddressUAddress $ entityVal a) + B.borderWithLabel + (str "Unified") + (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + getUA $ walletAddressUAddress $ entityVal a) <=> + B.borderWithLabel + (str "Legacy Shielded") + (txtWrapWith + (WrapSettings False True NoFill FillAfterFirst) + "Pending") <=> + B.borderWithLabel + (str "Transparent") + (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + maybe "Pending" (encodeTransparent (st ^. network)) $ + t_rec =<< + (isValidUnifiedAddress . + E.encodeUtf8 . getUA . walletAddressUAddress) + (entityVal a))) Nothing -> emptyWidget PhraseDisplay -> case L.listSelectedElement $ st ^. wallets of @@ -494,13 +513,15 @@ theApp = runZenithCLI :: T.Text -> Int -> T.Text -> IO () runZenithCLI host port dbFilePath = do - w <- checkZebra host port - case (w :: Maybe ZebraGetInfo) of - Just zebra -> do - bc <- checkBlockChain host port - case (bc :: Maybe ZebraGetBlockChainInfo) of - Nothing -> throwIO $ userError "Unable to determine blockchain status" - Just chainInfo -> do + w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) + case w of + Right zebra -> do + bc <- + try $ checkBlockChain host port :: IO + (Either IOError ZebraGetBlockChainInfo) + case bc of + Left e1 -> throwIO e1 + Right chainInfo -> do initDb dbFilePath walList <- getWallets dbFilePath $ zgb_net chainInfo accList <- @@ -531,10 +552,10 @@ runZenithCLI host port dbFilePath = do (zgb_blocks chainInfo) dbFilePath MsgDisplay - Nothing -> do + Left e -> do print $ "No Zebra node available on port " <> - show port <> ". Check your configuration" + show port <> ". Check your configuration." refreshWallet :: State -> IO State refreshWallet s = do diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 4e1d2c6..81ce9ff 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} --- Core wallet functionality for Zenith +-- | Core wallet functionality for Zenith module Zenith.Core where import Control.Exception (throwIO) @@ -39,28 +39,23 @@ import Zenith.Types checkZebra :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available - -> IO (Maybe ZebraGetInfo) + -> IO ZebraGetInfo checkZebra nodeHost nodePort = do res <- makeZebraCall nodeHost nodePort "getinfo" [] - let body = responseBody (res :: Response (RpcResponse ZebraGetInfo)) - return $ result body + case res of + Left e -> throwIO $ userError e + Right bi -> return bi -- | Checks the status of the Zcash blockchain checkBlockChain :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available - -> IO (Maybe ZebraGetBlockChainInfo) + -> IO ZebraGetBlockChainInfo checkBlockChain nodeHost nodePort = do - let f = makeZebraCall nodeHost nodePort - result . responseBody <$> f "getblockchaininfo" [] - --- | Generic RPC call function -connectZebra :: - FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a) -connectZebra nodeHost nodePort m params = do - res <- makeZebraCall nodeHost nodePort m params - let body = responseBody res - return $ result body + r <- makeZebraCall nodeHost nodePort "getblockchaininfo" [] + case r of + Left e -> throwIO $ userError e + Right bci -> return bci -- * Spending Keys -- | Create an Orchard Spending Key for the given wallet and account index diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 8345aef..4e510e0 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -19,13 +19,15 @@ module Zenith.DB where import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString as BS +import Data.HexString import qualified Data.Text as T import Database.Persist import Database.Persist.Sqlite import Database.Persist.TH import ZcashHaskell.Types (Scope(..), ZcashNet) import Zenith.Types - ( OrchardSpendingKeyDB(..) + ( HexStringDB(..) + , OrchardSpendingKeyDB(..) , PhraseDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) @@ -65,6 +67,47 @@ share deriving Show Eq |] +share + [mkPersist sqlSettings, mkMigrate "rawStorage"] + [persistLowerCase| + WalletTransaction + block Int + txId HexStringDB + conf Int + time Int + hex HexStringDB + deriving Show Eq + OrchAction + tx WalletTransactionId + nf HexStringDB + rk HexStringDB + cmx HexStringDB + ephKey HexStringDB + encCipher HexStringDB + outCipher HexStringDB + cv HexStringDB + auth HexStringDB + deriving Show Eq + ShieldOutput + tx WalletTransactionId + cv HexStringDB + cmu HexStringDB + ephKey HexStringDB + encCipher HexStringDB + outCipher HexStringDB + proof HexStringDB + deriving Show Eq + ShieldSpend + tx WalletTransactionId + cv HexStringDB + anchor HexStringDB + nullifier HexStringDB + rk HexStringDB + proof HexStringDB + authSig HexStringDB + deriving Show Eq + |] + -- * Database functions -- | Initializes the database initDb :: @@ -73,6 +116,12 @@ initDb :: initDb dbName = do runSqlite dbName $ do runMigration migrateAll +-- | Initializes the raw data storage +initRawStore :: + T.Text -- ^ the database path + -> IO () +initRawStore dbFilePath = runSqlite dbFilePath $ runMigration rawStorage + -- | Get existing wallets from database getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] getWallets dbFp n = diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs new file mode 100644 index 0000000..f426533 --- /dev/null +++ b/src/Zenith/Scanner.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Zenith.Scanner where + +import Control.Exception (throwIO, try) +import Data.Aeson +import Data.HexString +import qualified Data.Text as T +import GHC.Utils.Monad (concatMapM) +import Network.HTTP.Simple (getResponseBody) +import ZcashHaskell.Types + ( BlockResponse(..) + , RpcResponse(..) + , ZebraGetBlockChainInfo(..) + ) +import ZcashHaskell.Utils (makeZebraCall) +import Zenith.Core (checkBlockChain) +import Zenith.DB (initRawStore) +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 + -> Int -- ^ Port + -> T.Text -- ^ Path to database file + -> IO () +scanZebra b host port dbFilePath = do + _ <- initRawStore dbFilePath + bc <- + try $ checkBlockChain host port :: IO + (Either IOError ZebraGetBlockChainInfo) + case bc of + Left e -> print e + Right bStatus -> do + if b > zgb_blocks bStatus || b < 1 + then throwIO $ userError "Invalid starting block for scan" + else do + let bList = [b .. (zgb_blocks bStatus)] + txList <- + try $ concatMapM (processBlock host port) bList :: IO + (Either IOError [HexString]) + case txList of + Left e1 -> print e1 + Right txList' -> print txList' + +-- | Function to process a raw block and extract the transaction information +processBlock :: + T.Text -- ^ Host name for `zebrad` + -> Int -- ^ Port for `zebrad` + -> Int -- ^ The block number to process + -> IO [HexString] +processBlock host port b = do + r <- + makeZebraCall + host + port + "getblock" + [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] + case r of + Left e -> throwIO $ userError e + Right blk -> return $ bl_txs blk diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 715e338..33a946b 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -14,6 +14,7 @@ import Data.Aeson.Types (prependFailure, typeMismatch) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as C +import Data.HexString import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -29,6 +30,13 @@ import ZcashHaskell.Types , ZcashNet(..) ) +-- * Database field type wrappers +newtype HexStringDB = HexStringDB + { getHex :: HexString + } deriving newtype (Eq, Show, Read) + +derivePersistField "HexStringDB" + newtype ZcashNetDB = ZcashNetDB { getNet :: ZcashNet } deriving newtype (Eq, Show, Read) @@ -71,15 +79,8 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB derivePersistField "TransparentSpendingKeyDB" --- | A type to model Zcash RPC calls -data RpcCall = RpcCall - { jsonrpc :: T.Text - , id :: T.Text - , method :: T.Text - , params :: [Value] - } deriving (Show, Generic, ToJSON, FromJSON) - --- | Type for modelling the different address sources for Zcash 5.0.0 +-- * RPC +-- | Type for modelling the different address sources for `zcashd` 5.0.0 data AddressSource = LegacyRandom | Imported @@ -128,24 +129,6 @@ instance Show ZcashAddress where T.unpack (T.take 8 a) ++ "..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p --- | A type to model the response of the Zcash RPC -data RpcResponse r = RpcResponse - { err :: Maybe T.Text - , respId :: T.Text - , result :: r - } deriving (Show, Generic, ToJSON) - -instance (FromJSON r) => FromJSON (RpcResponse r) where - parseJSON (Object obj) = do - e <- obj .: "error" - rId <- obj .: "id" - r <- obj .: "result" - pure $ RpcResponse e rId r - parseJSON invalid = - prependFailure - "parsing RpcResponse failed, " - (typeMismatch "Object" invalid) - newtype NodeVersion = NodeVersion Integer deriving (Eq, Show) diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index ed648a4..0f325ff 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -2,11 +2,10 @@ module Zenith.Utils where -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C -import Data.Char +import Data.Aeson import Data.Functor (void) import Data.Maybe +import Data.Scientific (Scientific(..), scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E import System.Process (createProcess_, shell) @@ -20,6 +19,10 @@ import Zenith.Types , ZcashPool(..) ) +-- | Helper function to convert numbers into JSON +jsonNumber :: Int -> Value +jsonNumber i = Number $ scientific (fromIntegral i) 0 + -- | Helper function to display small amounts of ZEC displayZec :: Integer -> String displayZec s diff --git a/src/Zenith/Zcashd.hs b/src/Zenith/Zcashd.hs index d82cd1e..bc4c2d2 100644 --- a/src/Zenith/Zcashd.hs +++ b/src/Zenith/Zcashd.hs @@ -24,13 +24,12 @@ import System.IO import Text.Read (readMaybe) import Text.Regex import Text.Regex.Base +import ZcashHaskell.Types (RpcCall(..), RpcResponse(..)) import Zenith.Types ( AddressGroup , AddressSource(..) , NodeVersion(..) , OpResult(..) - , RpcCall(..) - , RpcResponse(..) , UABalance(..) , ZcashAddress(..) , ZcashPool(..) @@ -49,8 +48,11 @@ listAddresses user pwd = do Nothing -> fail "Couldn't parse node response" Just res -> do let addys = result res - let addList = concatMap getAddresses addys - return addList + case addys of + Nothing -> fail "Empty response" + Just addys' -> do + let addList = concatMap getAddresses addys' + return addList -- | Get address balance getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer] @@ -71,7 +73,9 @@ getBalance user pwd zadd = do case rpcResp of Nothing -> fail "Couldn't parse node response" Just res -> do - return [result res] + case result res of + Nothing -> return [] + Just r -> return [r] Just acct -> do response <- makeZcashCall @@ -83,7 +87,9 @@ getBalance user pwd zadd = do case rpcResp of Nothing -> fail "Couldn't parse node response" Just res -> do - return $ readUABalance (result res) + case result res of + Nothing -> return [0, 0, 0] + Just r -> return $ readUABalance r where readUABalance ua = [uatransparent ua, uasapling ua, uaorchard ua] @@ -96,7 +102,9 @@ listTxs user pwd zaddy = do case rpcResp of Nothing -> fail "listTxs: Couldn't parse node response" Just res -> do - return $ result res + case result res of + Nothing -> fail "listTxs: Empty response" + Just res' -> return res' -- | Send Tx sendTx :: @@ -150,7 +158,7 @@ sendTx user pwd fromAddy toAddy amount memo = do Nothing -> fail "Couldn't parse node response" Just res -> do putStr " Sending." - checkOpResult user pwd (result res) + checkOpResult user pwd (fromMaybe "" $ result res) else putStrLn "Error: Source address is view-only." else putStrLn "Error: Insufficient balance in source address." @@ -163,11 +171,14 @@ checkServer user pwd = do Nothing -> fail "Couldn't parse node response" Just myResp -> do let r = result myResp - if isNodeValid r - then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" - else do - putStrLn "Deprecated Zcash Full Node version found. Exiting" - exitFailure + case r of + Nothing -> fail "Empty node response" + Just r' -> do + if isNodeValid r' + then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" + else do + putStrLn "Deprecated Zcash Full Node version found. Exiting" + exitFailure where isNodeValid (NodeVersion i) = i >= 5000000 -- | Check for accounts @@ -235,7 +246,9 @@ checkOpResult user pwd opid = do Nothing -> fail "Couldn't parse node response" Just res -> do let r = result res - mapM_ showResult r + case r of + Nothing -> fail "Empty node response" + Just r' -> mapM_ showResult r' where showResult t = case opsuccess t of @@ -269,7 +282,7 @@ makeZcashCall username password m p = do let rpcResp = decode body :: Maybe (RpcResponse String) case rpcResp of Nothing -> fail $ "Unknown server error " ++ show response - Just x -> fail (result x) + Just x -> fail (fromMaybe "" $ result x) 401 -> fail "Incorrect full node credentials" 200 -> return body _ -> fail "Unknown error" diff --git a/zcash-haskell b/zcash-haskell index f228eff..f099544 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit f228eff367c776469455adc4d443102cc53e5538 +Subproject commit f0995441628381fee14ae1c655c3c4f8d96162e5 diff --git a/zenith.cabal b/zenith.cabal index 081df74..0da2c6d 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -32,6 +32,7 @@ library Zenith.Types Zenith.Utils Zenith.Zcashd + Zenith.Scanner hs-source-dirs: src build-depends: @@ -42,6 +43,8 @@ library , base64-bytestring , brick , bytestring + , ghc + , hexstring , http-client , http-conduit , http-types @@ -53,7 +56,6 @@ library , persistent-sqlite , persistent-template , process - , hexstring , regex-base , regex-compat , regex-posix @@ -86,6 +88,18 @@ 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 + , zenith + pkgconfig-depends: rustzcash_wrapper + default-language: Haskell2010 + test-suite zenith-tests type: exitcode-stdio-1.0 ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/zenith.cfg b/zenith.cfg index efedae5..9fb953b 100644 --- a/zenith.cfg +++ b/zenith.cfg @@ -3,3 +3,4 @@ nodePwd = "superSecret" dbFilePath = "zenith.db" zebraHost = "127.0.0.1" zebraPort = 18232 +dataStorePath = "datastore.db"