From 0a2e585eb920598bc646e3322c3596e8b4568aeb Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 22 Mar 2024 15:36:43 -0500 Subject: [PATCH] Add Zenith Scanner module --- app/ZenScan.hs | 15 +++++++++++++++ src/Zenith/CLI.hs | 45 +++++++++++++++++++++++++++++++------------ src/Zenith/Core.hs | 23 +++++++++------------- src/Zenith/DB.hs | 29 ++++++++++++++++++++++++++++ src/Zenith/Scanner.hs | 39 +++++++++++++++++++++++++------------ src/Zenith/Utils.hs | 9 ++++++--- src/Zenith/Zcashd.hs | 43 ++++++++++++++++++++++++++--------------- zcash-haskell | 2 +- zenith.cabal | 15 ++++++++++++++- 9 files changed, 162 insertions(+), 58 deletions(-) create mode 100644 app/ZenScan.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 ffad5fa..81ce9ff 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -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 67daeb6..4e510e0 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -77,6 +77,35 @@ share 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 diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index ccbd80f..f426533 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -2,9 +2,11 @@ module Zenith.Scanner where -import Control.Exception (throwIO) +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(..) @@ -13,6 +15,8 @@ import ZcashHaskell.Types ) 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 :: @@ -22,26 +26,37 @@ scanZebra :: -> T.Text -- ^ Path to database file -> IO () scanZebra b host port dbFilePath = do - bc <- checkBlockChain host port + _ <- initRawStore dbFilePath + bc <- + try $ checkBlockChain host port :: IO + (Either IOError ZebraGetBlockChainInfo) case bc of - Nothing -> throwIO $ userError "Failed to determine blockchain status" - Just bStatus -> do + 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)] - print bList + 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 :: - Int -- ^ The block number to process - -> T.Text -- ^ Host name for `zebrad` + T.Text -- ^ Host name for `zebrad` -> Int -- ^ Port for `zebrad` + -> Int -- ^ The block number to process -> IO [HexString] -processBlock b host port = do +processBlock host port b = do r <- - result . getResponseBody <$> - makeZebraCall host port "getblock" [fromIntegral b, 1] + makeZebraCall + host + port + "getblock" + [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] case r of - Nothing -> throwIO $ userError "Unable to get block data from Zebra" - Just b' -> return $ bl_txs b' + Left e -> throwIO $ userError e + Right blk -> return $ bl_txs blk 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 596e730..0da2c6d 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -43,6 +43,8 @@ library , base64-bytestring , brick , bytestring + , ghc + , hexstring , http-client , http-conduit , http-types @@ -54,7 +56,6 @@ library , persistent-sqlite , persistent-template , process - , hexstring , regex-base , regex-compat , regex-posix @@ -87,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