Implements scanning of transparent transactions #72

Merged
pitmutt merged 9 commits from rav001 into dev041 2024-03-27 18:40:58 +00:00
9 changed files with 162 additions and 58 deletions
Showing only changes of commit 0a2e585eb9 - Show all commits

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

View file

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

View file

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

View file

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

View file

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

View file

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

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

View file

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