Add Zenith Scanner module

This commit is contained in:
Rene Vergara 2024-03-22 15:36:43 -05:00
parent 60eee8c88d
commit 0a2e585eb9
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
9 changed files with 162 additions and 58 deletions

15
app/ZenScan.hs Normal file
View file

@ -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

View file

@ -1,5 +1,7 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Zenith.CLI where module Zenith.CLI where
@ -45,7 +47,7 @@ import Brick.Widgets.Core
) )
import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.List as L 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 (void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Maybe import Data.Maybe
@ -59,6 +61,8 @@ import Lens.Micro.Mtl
import Lens.Micro.TH import Lens.Micro.TH
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparent)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
@ -270,8 +274,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
Nothing Nothing
60) 60)
(padAll 1 $ (padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ B.borderWithLabel
getUA $ walletAddressUAddress $ entityVal a) (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 Nothing -> emptyWidget
PhraseDisplay -> PhraseDisplay ->
case L.listSelectedElement $ st ^. wallets of case L.listSelectedElement $ st ^. wallets of
@ -494,13 +513,15 @@ theApp =
runZenithCLI :: T.Text -> Int -> T.Text -> IO () runZenithCLI :: T.Text -> Int -> T.Text -> IO ()
runZenithCLI host port dbFilePath = do runZenithCLI host port dbFilePath = do
w <- checkZebra host port w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
case (w :: Maybe ZebraGetInfo) of case w of
Just zebra -> do Right zebra -> do
bc <- checkBlockChain host port bc <-
case (bc :: Maybe ZebraGetBlockChainInfo) of try $ checkBlockChain host port :: IO
Nothing -> throwIO $ userError "Unable to determine blockchain status" (Either IOError ZebraGetBlockChainInfo)
Just chainInfo -> do case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
initDb dbFilePath initDb dbFilePath
walList <- getWallets dbFilePath $ zgb_net chainInfo walList <- getWallets dbFilePath $ zgb_net chainInfo
accList <- accList <-
@ -531,10 +552,10 @@ runZenithCLI host port dbFilePath = do
(zgb_blocks chainInfo) (zgb_blocks chainInfo)
dbFilePath dbFilePath
MsgDisplay MsgDisplay
Nothing -> do Left e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
show port <> ". Check your configuration" show port <> ". Check your configuration."
refreshWallet :: State -> IO State refreshWallet :: State -> IO State
refreshWallet s = do refreshWallet s = do

View file

@ -39,28 +39,23 @@ import Zenith.Types
checkZebra :: checkZebra ::
T.Text -- ^ Host where `zebrad` is available T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> IO (Maybe ZebraGetInfo) -> IO ZebraGetInfo
checkZebra nodeHost nodePort = do checkZebra nodeHost nodePort = do
res <- makeZebraCall nodeHost nodePort "getinfo" [] res <- makeZebraCall nodeHost nodePort "getinfo" []
let body = responseBody (res :: Response (RpcResponse ZebraGetInfo)) case res of
return $ result body Left e -> throwIO $ userError e
Right bi -> return bi
-- | Checks the status of the Zcash blockchain -- | Checks the status of the Zcash blockchain
checkBlockChain :: checkBlockChain ::
T.Text -- ^ Host where `zebrad` is available T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> IO (Maybe ZebraGetBlockChainInfo) -> IO ZebraGetBlockChainInfo
checkBlockChain nodeHost nodePort = do checkBlockChain nodeHost nodePort = do
let f = makeZebraCall nodeHost nodePort r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
result . responseBody <$> f "getblockchaininfo" [] case r of
Left e -> throwIO $ userError e
-- | Generic RPC call function Right bci -> return bci
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
-- * Spending Keys -- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index -- | Create an Orchard Spending Key for the given wallet and account index

View file

@ -77,6 +77,35 @@ share
time Int time Int
hex HexStringDB hex HexStringDB
deriving Show Eq 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 -- * Database functions

View file

@ -2,9 +2,11 @@
module Zenith.Scanner where module Zenith.Scanner where
import Control.Exception (throwIO) import Control.Exception (throwIO, try)
import Data.Aeson
import Data.HexString import Data.HexString
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Utils.Monad (concatMapM)
import Network.HTTP.Simple (getResponseBody) import Network.HTTP.Simple (getResponseBody)
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
@ -13,6 +15,8 @@ import ZcashHaskell.Types
) )
import ZcashHaskell.Utils (makeZebraCall) import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Core (checkBlockChain) 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 -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
scanZebra :: scanZebra ::
@ -22,26 +26,37 @@ scanZebra ::
-> T.Text -- ^ Path to database file -> T.Text -- ^ Path to database file
-> IO () -> IO ()
scanZebra b host port dbFilePath = do scanZebra b host port dbFilePath = do
bc <- checkBlockChain host port _ <- initRawStore dbFilePath
bc <-
try $ checkBlockChain host port :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of case bc of
Nothing -> throwIO $ userError "Failed to determine blockchain status" Left e -> print e
Just bStatus -> do Right bStatus -> do
if b > zgb_blocks bStatus || b < 1 if b > zgb_blocks bStatus || b < 1
then throwIO $ userError "Invalid starting block for scan" then throwIO $ userError "Invalid starting block for scan"
else do else do
let bList = [b .. (zgb_blocks bStatus)] 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 -- | Function to process a raw block and extract the transaction information
processBlock :: processBlock ::
Int -- ^ The block number to process T.Text -- ^ Host name for `zebrad`
-> T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> Int -- ^ The block number to process
-> IO [HexString] -> IO [HexString]
processBlock b host port = do processBlock host port b = do
r <- r <-
result . getResponseBody <$> makeZebraCall
makeZebraCall host port "getblock" [fromIntegral b, 1] host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of case r of
Nothing -> throwIO $ userError "Unable to get block data from Zebra" Left e -> throwIO $ userError e
Just b' -> return $ bl_txs b' Right blk -> return $ bl_txs blk

View file

@ -2,11 +2,10 @@
module Zenith.Utils where module Zenith.Utils where
import qualified Data.ByteString as BS import Data.Aeson
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
@ -20,6 +19,10 @@ import Zenith.Types
, ZcashPool(..) , 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 -- | Helper function to display small amounts of ZEC
displayZec :: Integer -> String displayZec :: Integer -> String
displayZec s displayZec s

View file

@ -24,13 +24,12 @@ import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import Text.Regex import Text.Regex
import Text.Regex.Base import Text.Regex.Base
import ZcashHaskell.Types (RpcCall(..), RpcResponse(..))
import Zenith.Types import Zenith.Types
( AddressGroup ( AddressGroup
, AddressSource(..) , AddressSource(..)
, NodeVersion(..) , NodeVersion(..)
, OpResult(..) , OpResult(..)
, RpcCall(..)
, RpcResponse(..)
, UABalance(..) , UABalance(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
@ -49,7 +48,10 @@ listAddresses user pwd = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
let addys = result res let addys = result res
let addList = concatMap getAddresses addys case addys of
Nothing -> fail "Empty response"
Just addys' -> do
let addList = concatMap getAddresses addys'
return addList return addList
-- | Get address balance -- | Get address balance
@ -71,7 +73,9 @@ getBalance user pwd zadd = do
case rpcResp of case rpcResp of
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
return [result res] case result res of
Nothing -> return []
Just r -> return [r]
Just acct -> do Just acct -> do
response <- response <-
makeZcashCall makeZcashCall
@ -83,7 +87,9 @@ getBalance user pwd zadd = do
case rpcResp of case rpcResp of
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
return $ readUABalance (result res) case result res of
Nothing -> return [0, 0, 0]
Just r -> return $ readUABalance r
where readUABalance ua = where readUABalance ua =
[uatransparent ua, uasapling ua, uaorchard ua] [uatransparent ua, uasapling ua, uaorchard ua]
@ -96,7 +102,9 @@ listTxs user pwd zaddy = do
case rpcResp of case rpcResp of
Nothing -> fail "listTxs: Couldn't parse node response" Nothing -> fail "listTxs: Couldn't parse node response"
Just res -> do Just res -> do
return $ result res case result res of
Nothing -> fail "listTxs: Empty response"
Just res' -> return res'
-- | Send Tx -- | Send Tx
sendTx :: sendTx ::
@ -150,7 +158,7 @@ sendTx user pwd fromAddy toAddy amount memo = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
putStr " Sending." putStr " Sending."
checkOpResult user pwd (result res) checkOpResult user pwd (fromMaybe "" $ result res)
else putStrLn "Error: Source address is view-only." else putStrLn "Error: Source address is view-only."
else putStrLn "Error: Insufficient balance in source address." else putStrLn "Error: Insufficient balance in source address."
@ -163,7 +171,10 @@ checkServer user pwd = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just myResp -> do Just myResp -> do
let r = result myResp let r = result myResp
if isNodeValid r case r of
Nothing -> fail "Empty node response"
Just r' -> do
if isNodeValid r'
then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
else do else do
putStrLn "Deprecated Zcash Full Node version found. Exiting" putStrLn "Deprecated Zcash Full Node version found. Exiting"
@ -235,7 +246,9 @@ checkOpResult user pwd opid = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
let r = result res let r = result res
mapM_ showResult r case r of
Nothing -> fail "Empty node response"
Just r' -> mapM_ showResult r'
where where
showResult t = showResult t =
case opsuccess t of case opsuccess t of
@ -269,7 +282,7 @@ makeZcashCall username password m p = do
let rpcResp = decode body :: Maybe (RpcResponse String) let rpcResp = decode body :: Maybe (RpcResponse String)
case rpcResp of case rpcResp of
Nothing -> fail $ "Unknown server error " ++ show response Nothing -> fail $ "Unknown server error " ++ show response
Just x -> fail (result x) Just x -> fail (fromMaybe "" $ result x)
401 -> fail "Incorrect full node credentials" 401 -> fail "Incorrect full node credentials"
200 -> return body 200 -> return body
_ -> fail "Unknown error" _ -> fail "Unknown error"

@ -1 +1 @@
Subproject commit f228eff367c776469455adc4d443102cc53e5538 Subproject commit f0995441628381fee14ae1c655c3c4f8d96162e5

View file

@ -43,6 +43,8 @@ library
, base64-bytestring , base64-bytestring
, brick , brick
, bytestring , bytestring
, ghc
, hexstring
, http-client , http-client
, http-conduit , http-conduit
, http-types , http-types
@ -54,7 +56,6 @@ library
, persistent-sqlite , persistent-sqlite
, persistent-template , persistent-template
, process , process
, hexstring
, regex-base , regex-base
, regex-compat , regex-compat
, regex-posix , regex-posix
@ -87,6 +88,18 @@ executable zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 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 test-suite zenith-tests
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N