Compare commits

..

No commits in common. "0a2e585eb920598bc646e3322c3596e8b4568aeb" and "6b48f49760127a9d5d741eea47da449339f3148e" have entirely different histories.

11 changed files with 59 additions and 1171 deletions

1
.gitignore vendored
View file

@ -1,3 +1,2 @@
.stack-work/ .stack-work/
*~ *~
dist-newstyle/

View file

@ -1,15 +0,0 @@
{-# 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,7 +1,5 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Zenith.CLI where module Zenith.CLI where
@ -47,7 +45,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 (catch, throw, throwIO, try) import Control.Exception (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
@ -61,8 +59,6 @@ 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
@ -274,23 +270,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
Nothing Nothing
60) 60)
(padAll 1 $ (padAll 1 $
B.borderWithLabel txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
(str "Unified") getUA $ walletAddressUAddress $ entityVal a)
(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
@ -513,15 +494,13 @@ 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 <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) w <- checkZebra host port
case w of case (w :: Maybe ZebraGetInfo) of
Right zebra -> do Just zebra -> do
bc <- bc <- checkBlockChain host port
try $ checkBlockChain host port :: IO case (bc :: Maybe ZebraGetBlockChainInfo) of
(Either IOError ZebraGetBlockChainInfo) Nothing -> throwIO $ userError "Unable to determine blockchain status"
case bc of Just chainInfo -> do
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 <-
@ -552,10 +531,10 @@ runZenithCLI host port dbFilePath = do
(zgb_blocks chainInfo) (zgb_blocks chainInfo)
dbFilePath dbFilePath
MsgDisplay MsgDisplay
Left e -> do Nothing -> 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,23 +39,28 @@ 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 ZebraGetInfo -> IO (Maybe ZebraGetInfo)
checkZebra nodeHost nodePort = do checkZebra nodeHost nodePort = do
res <- makeZebraCall nodeHost nodePort "getinfo" [] res <- makeZebraCall nodeHost nodePort "getinfo" []
case res of let body = responseBody (res :: Response (RpcResponse ZebraGetInfo))
Left e -> throwIO $ userError e return $ result body
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 ZebraGetBlockChainInfo -> IO (Maybe ZebraGetBlockChainInfo)
checkBlockChain nodeHost nodePort = do checkBlockChain nodeHost nodePort = do
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" [] let f = makeZebraCall nodeHost nodePort
case r of result . responseBody <$> f "getblockchaininfo" []
Left e -> throwIO $ userError e
Right bci -> return bci -- | 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
-- * 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,35 +77,6 @@ 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,11 +2,9 @@
module Zenith.Scanner where module Zenith.Scanner where
import Control.Exception (throwIO, try) import Control.Exception (throwIO)
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(..)
@ -15,8 +13,6 @@ 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 ::
@ -26,37 +22,26 @@ 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
_ <- initRawStore dbFilePath bc <- checkBlockChain host port
bc <-
try $ checkBlockChain host port :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of case bc of
Left e -> print e Nothing -> throwIO $ userError "Failed to determine blockchain status"
Right bStatus -> do Just 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)]
txList <- print bList
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 ::
T.Text -- ^ Host name for `zebrad` Int -- ^ The block number to process
-> 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 host port b = do processBlock b host port = do
r <- r <-
makeZebraCall result . getResponseBody <$>
host makeZebraCall host port "getblock" [fromIntegral b, 1]
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of case r of
Left e -> throwIO $ userError e Nothing -> throwIO $ userError "Unable to get block data from Zebra"
Right blk -> return $ bl_txs blk Just b' -> return $ bl_txs b'

View file

@ -2,10 +2,11 @@
module Zenith.Utils where module Zenith.Utils where
import Data.Aeson import qualified Data.ByteString as BS
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)
@ -19,10 +20,6 @@ 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,12 +24,13 @@ 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(..)
@ -48,11 +49,8 @@ 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
case addys of let addList = concatMap getAddresses addys
Nothing -> fail "Empty response" return addList
Just addys' -> do
let addList = concatMap getAddresses addys'
return addList
-- | Get address balance -- | Get address balance
getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer] getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer]
@ -73,9 +71,7 @@ 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
case result res of return [result res]
Nothing -> return []
Just r -> return [r]
Just acct -> do Just acct -> do
response <- response <-
makeZcashCall makeZcashCall
@ -87,9 +83,7 @@ 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
case result res of return $ readUABalance (result res)
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]
@ -102,9 +96,7 @@ 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
case result res of return $ result res
Nothing -> fail "listTxs: Empty response"
Just res' -> return res'
-- | Send Tx -- | Send Tx
sendTx :: sendTx ::
@ -158,7 +150,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 (fromMaybe "" $ result res) checkOpResult user pwd (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."
@ -171,14 +163,11 @@ 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
case r of if isNodeValid r
Nothing -> fail "Empty node response" then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
Just r' -> do else do
if isNodeValid r' putStrLn "Deprecated Zcash Full Node version found. Exiting"
then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" exitFailure
else do
putStrLn "Deprecated Zcash Full Node version found. Exiting"
exitFailure
where isNodeValid (NodeVersion i) = i >= 5000000 where isNodeValid (NodeVersion i) = i >= 5000000
-- | Check for accounts -- | Check for accounts
@ -246,9 +235,7 @@ 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
case r of mapM_ showResult r
Nothing -> fail "Empty node response"
Just r' -> mapM_ showResult r'
where where
showResult t = showResult t =
case opsuccess t of case opsuccess t of
@ -282,7 +269,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 (fromMaybe "" $ result x) Just x -> fail (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 f0995441628381fee14ae1c655c3c4f8d96162e5 Subproject commit f228eff367c776469455adc4d443102cc53e5538

File diff suppressed because it is too large Load diff

View file

@ -43,8 +43,6 @@ library
, base64-bytestring , base64-bytestring
, brick , brick
, bytestring , bytestring
, ghc
, hexstring
, http-client , http-client
, http-conduit , http-conduit
, http-types , http-types
@ -56,6 +54,7 @@ library
, persistent-sqlite , persistent-sqlite
, persistent-template , persistent-template
, process , process
, hexstring
, regex-base , regex-base
, regex-compat , regex-compat
, regex-posix , regex-posix
@ -88,18 +87,6 @@ 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