Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

Milestone 3: RPC server, ZIP-320 #104

Merged
pitmutt merged 152 commits from milestone3 into master 2024-11-21 15:39:19 +00:00
Conversation 0 Commits 152 Files changed 22 +8598 -1153
22 changed files with 8598 additions and 1153 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitmodules vendored
View file

@ -1,4 +1,4 @@
[submodule "zcash-haskell"] [submodule "zcash-haskell"]
path = zcash-haskell path = zcash-haskell
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
branch = milestone2 branch = master

31
CHANGELOG.md
View file

@ -5,6 +5,37 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [0.7.0.0-beta]
### Added
- RPC module
- OpenRPC specification
- `listwallets` RPC method
- `listaccounts` RPC method
- `listaddresses` RPC method
- `listreceived` RPC method
- `getbalance` RPC method
- `getnewwallet` RPC method
- `getnewaccount` RPC method
- `getnewaddress` RPC method
- `getoperationstatus` RPC method
- `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy`
- Support for TEX addresses
- Functionality to shield transparent balance
- Functionality to de-shield shielded notes
- Native commitment trees
- Batch append to trees in O(log n)
### Changed
- Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection
- Refactored `ZcashPool`
- Preventing write operations to occur during wallet sync
## [0.6.0.0-beta] ## [0.6.0.0-beta]
### Added ### Added

17
app/Main.hs
View file

@ -19,8 +19,8 @@ import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.CLI import Zenith.CLI
import Zenith.Core (clearSync, testSync)
import Zenith.GUI (runZenithGUI) import Zenith.GUI (runZenithGUI)
import Zenith.Scanner (clearSync, rescanZebra)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils import Zenith.Utils
import Zenith.Zcashd import Zenith.Zcashd
@ -204,12 +204,15 @@ main :: IO ()
main = do main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"] config <- load ["$(HOME)/Zenith/zenith.cfg"]
args <- getArgs args <- getArgs
dbFilePath <- require config "dbFilePath" dbFileName <- require config "dbFileName"
{-nodeUser <- require config "nodeUser"-} nodeUser <- require config "nodeUser"
{-nodePwd <- require config "nodePwd"-} nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort" zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost" zebraHost <- require config "zebraHost"
let myConfig = Config dbFilePath zebraHost zebraPort nodePort <- require config "nodePort"
dbFP <- getZenithPath
let dbFilePath = T.pack $ dbFP ++ dbFileName
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
if not (null args) if not (null args)
then do then do
case head args case head args
@ -226,7 +229,8 @@ main = do
of of
"gui" -> runZenithGUI myConfig "gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig "tui" -> runZenithTUI myConfig
"rescan" -> clearSync myConfig "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
"resync" -> clearSync myConfig
_ -> printUsage _ -> printUsage
else printUsage else printUsage
@ -236,4 +240,5 @@ printUsage = do
putStrLn "Available commands:" putStrLn "Available commands:"
{-putStrLn "legacy\tLegacy CLI for zcashd"-} {-putStrLn "legacy\tLegacy CLI for zcashd"-}
putStrLn "tui\tTUI for zebrad" putStrLn "tui\tTUI for zebrad"
putStrLn "gui\tGUI for zebrad"
putStrLn "rescan\tRescan the existing wallet(s)" putStrLn "rescan\tRescan the existing wallet(s)"

91
app/Server.hs Normal file
View file

@ -0,0 +1,91 @@
{-# LANGUAGE OverloadedStrings #-}
module Server where
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throwIO, throwTo, try)
import Control.Monad (forever, when)
import Control.Monad.Logger (runNoLoggingT)
import Data.Configurator
import qualified Data.Text as T
import Network.Wai.Handler.Warp (run)
import Servant
import System.Exit
import System.Posix.Signals
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (getWallets, initDb, initPool)
import Zenith.RPC
( State(..)
, ZenithRPC(..)
, authenticate
, scanZebra
, zenithServer
)
import Zenith.Scanner (rescanZebra)
import Zenith.Types (Config(..))
import Zenith.Utils (getZenithPath)
main :: IO ()
main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"]
dbFileName <- require config "dbFileName"
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
nodePort <- require config "nodePort"
dbFP <- getZenithPath
let dbFilePath = T.pack $ dbFP ++ dbFileName
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
let ctx = authenticate myConfig :. EmptyContext
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
case w of
Right zebra -> do
bc <-
try $ checkBlockChain zebraHost zebraPort :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb dbFilePath
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zebraHost zebraPort dbFilePath
pool <- runNoLoggingT $ initPool dbFilePath
walList <- getWallets pool $ zgb_net chainInfo
if not (null walList)
then do
scanThread <-
forkIO $
forever $ do
_ <-
scanZebra
dbFilePath
zebraHost
zebraPort
(zgb_net chainInfo)
threadDelay 90000000
putStrLn "Zenith RPC Server 0.7.0.0-beta"
putStrLn "------------------------------"
putStrLn $
"Connected to " ++
show (zgb_net chainInfo) ++
" Zebra " ++
T.unpack (zgi_build zebra) ++ " on port " ++ show zebraPort
let myState =
State
(zgb_net chainInfo)
zebraHost
zebraPort
dbFilePath
(zgi_build zebra)
(zgb_blocks chainInfo)
run nodePort $
serveWithContext
(Proxy :: Proxy ZenithRPC)
ctx
(zenithServer myState)
else putStrLn
"No wallets available. Please start Zenith interactively to create a wallet"

2
app/ZenScan.hs
View file

@ -4,7 +4,7 @@ module ZenScan where
import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.Configurator import Data.Configurator
import Zenith.Scanner (scanZebra) import Zenith.Scanner (rescanZebra)
main :: IO () main :: IO ()
main = do main = do

41
cabal.project.freeze
View file

@ -41,8 +41,8 @@ constraints: any.Cabal ==3.10.3.0,
any.authenticate-oauth ==1.7, any.authenticate-oauth ==1.7,
any.auto-update ==0.2.1, any.auto-update ==0.2.1,
any.base ==4.18.2.1, any.base ==4.18.2.1,
any.base-compat ==0.14.0, any.base-compat ==0.13.1,
any.base-compat-batteries ==0.14.0, any.base-compat-batteries ==0.13.1,
any.base-orphans ==0.9.2, any.base-orphans ==0.9.2,
any.base16 ==1.0, any.base16 ==1.0,
any.base16-bytestring ==1.0.2.0, any.base16-bytestring ==1.0.2.0,
@ -59,9 +59,12 @@ constraints: any.Cabal ==3.10.3.0,
any.blaze-builder ==0.4.2.3, any.blaze-builder ==0.4.2.3,
any.blaze-html ==0.9.2.0, any.blaze-html ==0.9.2.0,
any.blaze-markup ==0.8.3.0, any.blaze-markup ==0.8.3.0,
any.boring ==0.2.2,
boring +tagged,
any.borsh ==0.3.0, any.borsh ==0.3.0,
any.brick ==2.4, any.brick ==2.4,
brick -demos, brick -demos,
any.bsb-http-chunked ==0.0.0.4,
any.byteorder ==1.0.4, any.byteorder ==1.0.4,
any.bytes ==0.17.3, any.bytes ==0.17.3,
any.bytestring ==0.11.5.3, any.bytestring ==0.11.5.3,
@ -90,6 +93,7 @@ constraints: any.Cabal ==3.10.3.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.configurator ==0.3.0.0, any.configurator ==0.3.0.0,
configurator -developer, configurator -developer,
any.constraints ==0.14.2,
any.containers ==0.6.7, any.containers ==0.6.7,
any.contravariant ==1.5.5, any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
@ -113,6 +117,7 @@ constraints: any.Cabal ==3.10.3.0,
any.data-default-instances-dlist ==0.0.1, any.data-default-instances-dlist ==0.0.1,
any.data-default-instances-old-locale ==0.0.1, any.data-default-instances-old-locale ==0.0.1,
any.data-fix ==0.3.4, any.data-fix ==0.3.4,
any.dec ==0.0.6,
any.deepseq ==1.4.8.1, any.deepseq ==1.4.8.1,
any.directory ==1.3.8.4, any.directory ==1.3.8.4,
any.distributive ==0.6.2.1, any.distributive ==0.6.2.1,
@ -129,6 +134,7 @@ constraints: any.Cabal ==3.10.3.0,
any.exceptions ==0.10.7, any.exceptions ==0.10.7,
any.extra ==1.7.16, any.extra ==1.7.16,
any.fast-logger ==3.2.3, any.fast-logger ==3.2.3,
any.file-embed ==0.0.16.0,
any.filepath ==1.4.300.1, any.filepath ==1.4.300.1,
any.fixed ==0.3, any.fixed ==0.3,
any.foreign-rust ==0.1.0, any.foreign-rust ==0.1.0,
@ -169,7 +175,12 @@ constraints: any.Cabal ==3.10.3.0,
any.http-client-tls ==0.3.6.3, any.http-client-tls ==0.3.6.3,
any.http-conduit ==2.3.8.3, any.http-conduit ==2.3.8.3,
http-conduit +aeson, http-conduit +aeson,
any.http-date ==0.0.11,
any.http-media ==0.8.1.1,
any.http-semantics ==0.1.2,
any.http-types ==0.12.4, any.http-types ==0.12.4,
any.http2 ==5.2.6,
http2 -devel -h2spec,
any.indexed-traversable ==0.1.4, any.indexed-traversable ==0.1.4,
any.indexed-traversable-instances ==0.1.2, any.indexed-traversable-instances ==0.1.2,
any.integer-conversion ==0.1.1, any.integer-conversion ==0.1.1,
@ -196,6 +207,7 @@ constraints: any.Cabal ==3.10.3.0,
any.microlens-mtl ==0.2.0.3, any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.15, any.microlens-th ==0.4.3.15,
any.mime-types ==0.1.2.0, any.mime-types ==0.1.2.0,
any.mmorph ==1.2.0,
any.monad-control ==1.0.3.1, any.monad-control ==1.0.3.1,
any.monad-logger ==0.3.40, any.monad-logger ==0.3.40,
monad-logger +template_haskell, monad-logger +template_haskell,
@ -210,9 +222,13 @@ constraints: any.Cabal ==3.10.3.0,
nanovg -examples -gl2 -gles3 -stb_truetype, nanovg -examples -gl2 -gles3 -stb_truetype,
any.network ==3.2.1.0, any.network ==3.2.1.0,
network -devel, network -devel,
any.network-byte-order ==0.1.7,
any.network-control ==0.1.1,
any.network-uri ==2.6.4.2, any.network-uri ==2.6.4.2,
any.old-locale ==1.0.0.7, any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.4, any.old-time ==1.1.0.4,
any.optparse-applicative ==0.18.1.0,
optparse-applicative +process,
any.os-string ==2.0.6, any.os-string ==2.0.6,
any.parallel ==3.2.2.0, any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1, any.parsec ==3.1.16.1,
@ -225,6 +241,9 @@ constraints: any.Cabal ==3.10.3.0,
persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4, persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4,
any.persistent-template ==2.12.0.0, any.persistent-template ==2.12.0.0,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.prettyprinter ==1.7.1,
prettyprinter -buildreadme +text,
any.prettyprinter-ansi-terminal ==1.1.3,
any.primitive ==0.9.0.0, any.primitive ==0.9.0.0,
any.process ==1.6.19.0, any.process ==1.6.19.0,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
@ -236,6 +255,7 @@ constraints: any.Cabal ==3.10.3.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.quickcheck-transformer ==0.3.1.2, any.quickcheck-transformer ==0.3.1.2,
any.random ==1.2.1.2, any.random ==1.2.1.2,
any.recv ==0.1.0,
any.reflection ==2.1.8, any.reflection ==2.1.8,
reflection -slow +template-haskell, reflection -slow +template-haskell,
any.regex-base ==0.94.0.2, any.regex-base ==0.94.0.2,
@ -260,8 +280,15 @@ constraints: any.Cabal ==3.10.3.0,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
any.serialise ==0.2.6.1, any.serialise ==0.2.6.1,
serialise +newtime15, serialise +newtime15,
any.servant ==0.20.1,
any.servant-server ==0.20,
any.silently ==1.2.5.3, any.silently ==1.2.5.3,
any.simple-sendfile ==0.2.32,
simple-sendfile +allow-bsd -fallback,
any.singleton-bool ==0.1.8,
any.socks ==0.6.1, any.socks ==0.6.1,
any.some ==1.0.6,
some +newtype-unsafe,
any.sop-core ==0.5.0.2, any.sop-core ==0.5.0.2,
any.sort ==1.0.0.0, any.sort ==1.0.0.0,
any.split ==0.2.5, any.split ==0.2.5,
@ -296,6 +323,7 @@ constraints: any.Cabal ==3.10.3.0,
any.time-compat ==1.9.7, any.time-compat ==1.9.7,
any.time-locale-compat ==0.1.1.5, any.time-locale-compat ==0.1.1.5,
time-locale-compat -old-locale, time-locale-compat -old-locale,
any.time-manager ==0.1.0,
any.tls ==2.1.0, any.tls ==2.1.0,
tls -devel, tls -devel,
any.transformers ==0.6.1.0, any.transformers ==0.6.1.0,
@ -326,9 +354,18 @@ constraints: any.Cabal ==3.10.3.0,
any.vty-crossplatform ==0.4.0.0, any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos, vty-crossplatform -demos,
any.vty-unix ==0.2.0.0, any.vty-unix ==0.2.0.0,
any.wai ==3.2.4,
any.wai-app-static ==3.1.9,
wai-app-static +crypton -print,
any.wai-extra ==3.1.15,
wai-extra -build-example,
any.wai-logger ==2.4.0,
any.warp ==3.4.1,
warp +allow-sendfilefd -network-bytestring -warp-debug +x509,
any.wide-word ==0.1.6.0, any.wide-word ==0.1.6.0,
any.witherable ==0.5, any.witherable ==0.5,
any.word-wrap ==0.5, any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.wreq ==0.5.4.3, any.wreq ==0.5.4.3,
wreq -aws -developer +doctest -httpbin, wreq -aws -developer +doctest -httpbin,
any.zlib ==0.7.1.0, any.zlib ==0.7.1.0,

613
src/Zenith/CLI.hs
View file

@ -2,6 +2,7 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.CLI where module Zenith.CLI where
@ -10,16 +11,15 @@ import qualified Brick.BChan as BC
import qualified Brick.Focus as F import qualified Brick.Focus as F
import Brick.Forms import Brick.Forms
( Form(..) ( Form(..)
, FormFieldState
, (@@=) , (@@=)
, allFieldsValid , allFieldsValid
, editShowableField
, editShowableFieldWithValidate , editShowableFieldWithValidate
, editTextField , editTextField
, focusedFormInputAttr , focusedFormInputAttr
, handleFormEvent , handleFormEvent
, invalidFormInputAttr , invalidFormInputAttr
, newForm , newForm
, radioField
, renderForm , renderForm
, setFieldValid , setFieldValid
, updateFormState , updateFormState
@ -42,7 +42,6 @@ import Brick.Widgets.Core
, joinBorders , joinBorders
, padAll , padAll
, padBottom , padBottom
, padLeft
, padTop , padTop
, setAvailableSize , setAvailableSize
, str , str
@ -63,13 +62,20 @@ import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (catch, throw, throwIO, try) import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, void) import Control.Monad (forM_, forever, unless, void, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT) import Control.Monad.Logger
( LoggingT
, NoLoggingT
, logDebugN
, runNoLoggingT
, runStderrLoggingT
)
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
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 Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@ -83,10 +89,13 @@ import Lens.Micro.Mtl
import Lens.Micro.TH import Lens.Micro.TH
import System.Hclip import System.Hclip
import Text.Printf import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) ( getSaplingFromUA
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeTransparentAddress ( decodeTransparentAddress
, encodeTransparentReceiver , encodeTransparentReceiver
@ -95,19 +104,26 @@ import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Scanner (processTx, updateConfs) import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ShieldDeshieldOp(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZenithStatus(..)
) )
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
, displayZec , displayZec
, getChainTip
, isRecipientValid , isRecipientValid
, isRecipientValidGUI
, jsonNumber , jsonNumber
, parseAddress
, showAddress , showAddress
, validBarValue , validBarValue
) )
@ -126,6 +142,14 @@ data Name
| ABList | ABList
| DescripField | DescripField
| AddressField | AddressField
| PrivacyNoneField
| PrivacyLowField
| PrivacyMediumField
| PrivacyFullField
| ShieldField
| DeshieldField
| TotalTranspField
| TotalShieldedField
deriving (Eq, Show, Ord) deriving (Eq, Show, Ord)
data DialogInput = DialogInput data DialogInput = DialogInput
@ -136,8 +160,9 @@ makeLenses ''DialogInput
data SendInput = SendInput data SendInput = SendInput
{ _sendTo :: !T.Text { _sendTo :: !T.Text
, _sendAmt :: !Float , _sendAmt :: !Scientific
, _sendMemo :: !T.Text , _sendMemo :: !T.Text
, _policyField :: !PrivacyPolicy
} deriving (Show) } deriving (Show)
makeLenses ''SendInput makeLenses ''SendInput
@ -149,6 +174,12 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
newtype ShDshEntry = ShDshEntry
{ _shAmt :: Scientific
} deriving (Show)
makeLenses ''ShDshEntry
data DialogType data DialogType
= WName = WName
| AName | AName
@ -161,6 +192,8 @@ data DialogType
| AdrBookForm | AdrBookForm
| AdrBookUpdForm | AdrBookUpdForm
| AdrBookDelForm | AdrBookDelForm
| DeshieldForm
| ShieldForm
data DisplayType data DisplayType
= AddrDisplay = AddrDisplay
@ -178,6 +211,9 @@ data Tick
| TickMsg !String | TickMsg !String
| TickTx !HexString | TickTx !HexString
data DropDownItem =
DropdownItem String
data State = State data State = State
{ _network :: !ZcashNet { _network :: !ZcashNet
, _wallets :: !(L.List Name (Entity ZcashWallet)) , _wallets :: !(L.List Name (Entity ZcashWallet))
@ -206,6 +242,9 @@ data State = State
, _abCurAdrs :: !T.Text -- used for address book CRUD operations , _abCurAdrs :: !T.Text -- used for address book CRUD operations
, _sentTx :: !(Maybe HexString) , _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer , _unconfBalance :: !Integer
, _deshieldForm :: !(Form ShDshEntry () Name)
, _tBalance :: !Integer
, _sBalance :: !Integer
} }
makeLenses ''State makeLenses ''State
@ -222,11 +261,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(" Zenith - " <> (" Zenith - " <>
show (st ^. network) <> show (st ^. network) <>
" - " <> " - " <>
(T.unpack T.unpack
(maybe (maybe
"(None)" "(None)"
(\(_, w) -> zcashWalletName $ entityVal w) (\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets)))) ++ (L.listSelectedElement (st ^. wallets))) ++
" ")) " "))
(C.hCenter (C.hCenter
(str (str
@ -253,17 +292,24 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(C.hCenter (C.hCenter
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=> (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=> listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
C.hCenter (vBox
[ C.hCenter
(hBox (hBox
[ capCommand "W" "allets" [ capCommand "W" "allets"
, capCommand "A" "ccounts" , capCommand "A" "ccounts"
, capCommand "V" "iew address" , capCommand "V" "iew address"
, capCommand "S" "end Tx" , capCommand3 "" "S" "end Tx"
, capCommand2 "Address " "B" "ook" ])
, C.hCenter
(hBox
[ capCommand2 "Address " "B" "ook"
, capCommand2 "s" "H" "ield"
, capCommand "D" "e-shield"
, capCommand "Q" "uit" , capCommand "Q" "uit"
, capCommand "?" " Help" , capCommand "?" " Help"
, str $ show (st ^. timer) , str $ show (st ^. timer)
]) ])
])
listBox :: Show e => String -> L.List Name e -> Widget Name listBox :: Show e => String -> L.List Name e -> Widget Name
listBox titleLabel l = listBox titleLabel l =
C.vCenter $ C.vCenter $
@ -329,7 +375,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
else emptyWidget else emptyWidget
where where
keyList = keyList =
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"] map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "q"]
actionList = actionList =
map map
(hLimit 40 . str) (hLimit 40 . str)
@ -340,6 +386,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, "View address" , "View address"
, "Send Tx" , "Send Tx"
, "Address Book" , "Address Book"
, "Shield/De-Shield"
, "Quit" , "Quit"
] ]
inputDialog :: State -> Widget Name inputDialog :: State -> Widget Name
@ -386,6 +433,37 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(renderForm (st ^. txForm) <=> (renderForm (st ^. txForm) <=>
C.hCenter C.hCenter
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"])) (hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
DeshieldForm ->
D.renderDialog
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
(C.hCenter
(padAll 1 $
vBox
[ str $
"Transparent Bal.: " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance)
, str $
"Shielded Bal.: " ++
if st ^. network == MainNet
then displayZec (st ^. sBalance)
else displayTaz (st ^. sBalance)
]) <=>
renderForm (st ^. deshieldForm) <=>
C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
ShieldForm ->
D.renderDialog
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
(C.hCenter
(str $
"Shield " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance) ++ "?") <=>
C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
Blank -> emptyWidget Blank -> emptyWidget
-- Address Book List -- Address Book List
AdrBook -> AdrBook ->
@ -450,7 +528,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(str (str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
C.hCenter C.hCenter
(withAttr titleAttr (str "Zcash Wallet v0.6.0.0-beta")) <=> (withAttr titleAttr (str "Zcash Wallet v0.7.0.0-beta")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key...")) C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget else emptyWidget
capCommand3 :: String -> String -> String -> Widget Name capCommand3 :: String -> String -> String -> Widget Name
@ -610,14 +688,34 @@ mkInputForm =
mkSendForm :: Integer -> SendInput -> Form SendInput e Name mkSendForm :: Integer -> SendInput -> Form SendInput e Name
mkSendForm bal = mkSendForm bal =
newForm newForm
[ label "To: " @@= editTextField sendTo RecField (Just 1) [ label "Privacy Level :" @@=
radioField
policyField
[ (Full, PrivacyFullField, "Full")
, (Medium, PrivacyMediumField, "Medium")
, (Low, PrivacyLowField, "Low")
, (None, PrivacyNoneField, "None")
]
, label "To: " @@= editTextField sendTo RecField (Just 1)
, label "Amount: " @@= , label "Amount: " @@=
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal) editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1) , label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkDeshieldForm tbal =
newForm
[ label "Amount: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
]
where
isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
@ -722,19 +820,32 @@ abSelAttr = A.attrName "abselected"
abMBarAttr :: A.AttrName abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar" abMBarAttr = A.attrName "menubar"
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra ::
scanZebra dbP zHost zPort b eChan = do T.Text
_ <- liftIO $ initDb dbP -> T.Text
-> Int
-> Int
-> BC.BChan Tick
-> ZcashNet
-> NoLoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
case confUp of syncChk <- liftIO $ isSyncing pool
Left _e0 -> if syncChk
liftIO $ then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" else do
Right _ -> do logDebugN $
let sb = max dbBlock b "dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
when (chkBlock /= dbBlock && chkBlock /= 1) $
rewindWalletData pool sb $ ZcashNetDB znet
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ liftIO $
@ -746,8 +857,28 @@ scanZebra dbP zHost zPort b eChan = do
let step = let step =
(1.0 :: Float) / (1.0 :: Float) /
fromIntegral (zgb_blocks bStatus - (sb + 1)) fromIntegral (zgb_blocks bStatus - (sb + 1))
mapM_ (processBlock pool step) bList _ <- liftIO $ startSync pool
else liftIO $ BC.writeBChan eChan $ TickVal 1.0 mapM_ (liftIO . processBlock pool step) bList
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
IO
(Either IOError ())
case confUp of
Left _e0 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $
BC.writeBChan eChan $
TickMsg "Failed to update unconfirmed transactions"
Right _ -> do
logDebugN "Updated confirmations"
logDebugN "Starting commitment tree update"
_ <- updateCommitmentTrees pool zHost zPort (ZcashNetDB znet)
logDebugN "Finished tree update"
_ <- liftIO $ completeSync pool Successful
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
return ()
else do
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
where where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -759,7 +890,9 @@ scanZebra dbP zHost zPort b eChan = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
case r of case r of
Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1 Left e1 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $ BC.writeBChan eChan $ TickMsg e1
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -769,19 +902,21 @@ scanZebra dbP zHost zPort b eChan = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
case r2 of case r2 of
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Left e2 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $ BC.writeBChan eChan $ TickMsg e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ bi <-
bl_txs $ addTime blk blockTime saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB znet)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
liftIO $ BC.writeBChan eChan $ TickVal step liftIO $ BC.writeBChan eChan $ TickVal step
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State () appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
appEvent (BT.AppEvent t) = do appEvent (BT.AppEvent t) = do
@ -791,7 +926,35 @@ appEvent (BT.AppEvent t) = do
TickMsg m -> do TickMsg m -> do
case s ^. displayBox of case s ^. displayBox of
AddrDisplay -> return () AddrDisplay -> return ()
MsgDisplay -> return () MsgDisplay -> do
when (m == "startSync") $ do
selWallet <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing -> throw $ userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
_ <-
liftIO $
runNoLoggingT $
syncWallet
(Config
(s ^. dbPath)
(s ^. zebraHost)
(s ^. zebraPort)
"user"
"pwd"
8080)
selWallet
updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState
BT.put ns
BT.modify $ set msg ""
BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> return () PhraseDisplay -> return ()
TxDisplay -> return () TxDisplay -> return ()
TxIdDisplay -> return () TxIdDisplay -> return ()
@ -814,26 +977,9 @@ appEvent (BT.AppEvent t) = do
SyncDisplay -> do SyncDisplay -> do
if s ^. barValue == 1.0 if s ^. barValue == 1.0
then do then do
selWallet <- BT.modify $ set msg "Decoding, please wait..."
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing -> throw $ userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
_ <-
liftIO $
syncWallet
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0 BT.modify $ set barValue 0.0
updatedState <- BT.get BT.modify $ set displayBox MsgDisplay
ns <- liftIO $ refreshWallet updatedState
BT.put ns
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue) else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
BlankDisplay -> do BlankDisplay -> do
case s ^. dialogBox of case s ^. dialogBox of
@ -847,21 +993,27 @@ appEvent (BT.AppEvent t) = do
AdrBookForm -> return () AdrBookForm -> return ()
AdrBookUpdForm -> return () AdrBookUpdForm -> return ()
AdrBookDelForm -> return () AdrBookDelForm -> return ()
DeshieldForm -> return ()
ShieldForm -> return ()
Blank -> do Blank -> do
if s ^. timer == 90 if s ^. timer == 90
then do then do
BT.modify $ set barValue 0.0 BT.modify $ set barValue 0.0
BT.modify $ set displayBox SyncDisplay BT.modify $ set displayBox SyncDisplay
sBlock <- liftIO $ getMinBirthdayHeight pool sBlock <-
liftIO $
getMinBirthdayHeight pool (ZcashNetDB $ s ^. network)
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runNoLoggingT $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
(s ^. zebraPort) (s ^. zebraPort)
sBlock sBlock
(s ^. eventDispatch) (s ^. eventDispatch)
(s ^. network)
BT.modify $ set timer 0 BT.modify $ set timer 0
return () return ()
else BT.modify $ set timer $ 1 + s ^. timer else BT.modify $ set timer $ 1 + s ^. timer
@ -1063,7 +1215,8 @@ appEvent (BT.VtyEvent e) = do
Just (_k, w) -> return w Just (_k, w) -> return w
fs1 <- BT.zoom txForm $ BT.gets formState fs1 <- BT.zoom txForm $ BT.gets formState
bl <- bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal liftIO $
getChainTip (s ^. zebraHost) (s ^. zebraPort)
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
@ -1078,6 +1231,7 @@ appEvent (BT.VtyEvent e) = do
(fs1 ^. sendAmt) (fs1 ^. sendAmt)
(fs1 ^. sendTo) (fs1 ^. sendTo)
(fs1 ^. sendMemo) (fs1 ^. sendMemo)
(fs1 ^. policyField)
BT.modify $ set msg "Preparing transaction..." BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank BT.modify $ set dialogBox Blank
@ -1091,8 +1245,103 @@ appEvent (BT.VtyEvent e) = do
fs <- BT.gets formState fs <- BT.gets formState
BT.modify $ BT.modify $
setFieldValid setFieldValid
(isRecipientValid (fs ^. sendTo)) (isRecipientValidGUI
(fs ^. policyField)
(fs ^. sendTo))
RecField RecField
DeshieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'p') [] -> do
if allFieldsValid (s ^. deshieldForm)
then do
pool <-
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAddr <-
do case L.listSelectedElement $ s ^. addresses of
Nothing -> do
let fAddr =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. addresses
case fAddr of
Nothing ->
throw $
userError "Failed to select address"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
fs1 <- BT.zoom deshieldForm $ BT.gets formState
let tAddrMaybe =
Transparent <$>
((decodeTransparentAddress .
E.encodeUtf8 .
encodeTransparentReceiver (s ^. network)) =<<
(t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 .
getUA . walletAddressUAddress)
(entityVal selAddr)))
bl <-
liftIO $
getChainTip (s ^. zebraHost) (s ^. zebraPort)
case tAddrMaybe of
Nothing -> do
BT.modify $
set
msg
"Failed to obtain transparent address"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
Just tAddr -> do
_ <-
liftIO $
forkIO $
deshieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
(ProposedNote
(ValidAddressAPI tAddr)
(fs1 ^. shAmt)
Nothing)
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
else do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
AdrBook -> do AdrBook -> do
case e of case e of
V.EvKey (V.KChar 'x') [] -> V.EvKey (V.KChar 'x') [] ->
@ -1110,7 +1359,7 @@ appEvent (BT.VtyEvent e) = do
"Address copied to Clipboard from >>\n" ++ "Address copied to Clipboard from >>\n" ++
T.unpack (addressBookAbdescrip (entityVal a)) T.unpack (addressBookAbdescrip (entityVal a))
BT.modify $ set displayBox MsgDisplay BT.modify $ set displayBox MsgDisplay
_ -> do _any -> do
BT.modify $ BT.modify $
set msg "Error while copying the address!!" set msg "Error while copying the address!!"
BT.modify $ set displayBox MsgDisplay BT.modify $ set displayBox MsgDisplay
@ -1125,7 +1374,8 @@ appEvent (BT.VtyEvent e) = do
(SendInput (SendInput
(addressBookAbaddress (entityVal a)) (addressBookAbaddress (entityVal a))
0.0 0.0
"") ""
Full)
BT.modify $ set dialogBox SendTx BT.modify $ set dialogBox SendTx
_ -> do _ -> do
BT.modify $ BT.modify $
@ -1275,6 +1525,53 @@ appEvent (BT.VtyEvent e) = do
BT.put s' BT.put s'
BT.modify $ set dialogBox AdrBook BT.modify $ set dialogBox AdrBook
ev -> BT.modify $ set dialogBox AdrBookDelForm ev -> BT.modify $ set dialogBox AdrBookDelForm
ShieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'p') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal
_ <-
liftIO $
forkIO $
shieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
-- Process any other event -- Process any other event
Blank -> do Blank -> do
case e of case e of
@ -1297,10 +1594,61 @@ appEvent (BT.VtyEvent e) = do
V.EvKey (V.KChar 's') [] -> do V.EvKey (V.KChar 's') [] -> do
BT.modify $ BT.modify $
set txForm $ set txForm $
mkSendForm (s ^. balance) (SendInput "" 0.0 "") mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
BT.modify $ set dialogBox SendTx BT.modify $ set dialogBox SendTx
V.EvKey (V.KChar 'b') [] -> V.EvKey (V.KChar 'b') [] ->
BT.modify $ set dialogBox AdrBook BT.modify $ set dialogBox AdrBook
V.EvKey (V.KChar 'd') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
tBal <-
liftIO $
getTransparentBalance pool $ entityKey selAcc
sBal <-
liftIO $ getShieldedBalance pool $ entityKey selAcc
BT.modify $ set tBalance tBal
BT.modify $ set sBalance sBal
BT.modify $
set deshieldForm $
mkDeshieldForm sBal (ShDshEntry 0.0)
BT.modify $ set dialogBox DeshieldForm
V.EvKey (V.KChar 'h') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
tBal <-
liftIO $
getTransparentBalance pool $ entityKey selAcc
BT.modify $ set tBalance tBal
if tBal > 20000
then BT.modify $ set dialogBox ShieldForm
else do
BT.modify $
set
msg
"Not enough transparent funds in this account"
BT.modify $ set displayBox MsgDisplay
ev -> ev ->
case r of case r of
Just AList -> Just AList ->
@ -1315,6 +1663,8 @@ appEvent (BT.VtyEvent e) = do
printMsg s = BT.modify $ updateMsg s printMsg s = BT.modify $ updateMsg s
updateMsg :: String -> State -> State updateMsg :: String -> State -> State
updateMsg = set msg updateMsg = set msg
-- fs <- BT.gets formState
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
appEvent _ = return () appEvent _ = return ()
theMap :: A.AttrMap theMap :: A.AttrMap
@ -1363,15 +1713,22 @@ runZenithTUI config = do
case bc of case bc of
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
initDb dbFilePath x <- initDb dbFilePath
_ <- upgradeQrTable pool
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra host port dbFilePath
walList <- getWallets pool $ zgb_net chainInfo walList <- getWallets pool $ zgb_net chainInfo
accList <- accList <-
if not (null walList) if not (null walList)
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList then runNoLoggingT $
getAccounts pool $ entityKey $ head walList
else return [] else return []
addrList <- addrList <-
if not (null accList) if not (null accList)
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList then runNoLoggingT $
getAddresses pool $ entityKey $ head accList
else return [] else return []
txList <- txList <-
if not (null addrList) if not (null addrList)
@ -1390,6 +1747,14 @@ runZenithTUI config = do
if not (null accList) if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0 else return 0
tBal <-
if not (null accList)
then getTransparentBalance pool $ entityKey $ head accList
else return 0
sBal <-
if not (null accList)
then getShieldedBalance pool $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10 eventChan <- BC.newBChan 10
_ <- _ <-
forkIO $ forkIO $
@ -1403,11 +1768,12 @@ runZenithTUI config = do
State State
(zgb_net chainInfo) (zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1) (L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0) (L.list AcList (Vec.fromList accList) 1)
(L.list AList (Vec.fromList addrList) 1) (L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1) (L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++ ("Start up Ok! Connected to Zebra " ++
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") (T.unpack . zgi_build) zebra ++
" on port " ++ show port ++ ".")
False False
(if null walList (if null walList
then WName then WName
@ -1425,13 +1791,16 @@ runZenithTUI config = do
1.0 1.0
eventChan eventChan
0 0
(mkSendForm 0 $ SendInput "" 0.0 "") (mkSendForm 0 $ SendInput "" 0.0 "" Full)
(L.list ABList (Vec.fromList abookList) 1) (L.list ABList (Vec.fromList abookList) 1)
(mkNewABForm (AdrBookEntry "" "")) (mkNewABForm (AdrBookEntry "" ""))
"" ""
Nothing Nothing
uBal uBal
Left e -> do (mkDeshieldForm 0 (ShDshEntry 0.0))
tBal
sBal
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."
@ -1450,7 +1819,7 @@ refreshWallet s = do
Just (j, w1) -> return (j, w1) Just (j, w1) -> return (j, w1)
Just (k, w) -> return (k, w) Just (k, w) -> return (k, w)
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet let bl = zcashWalletLastSync $ entityVal $ walList !! ix
addrL <- addrL <-
if not (null aL) if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@ -1641,22 +2010,90 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy
-> IO () -> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
BC.writeBChan chan $ TickMsg "Preparing transaction..." BC.writeBChan chan $ TickMsg "Preparing transaction..."
case parseAddress ua znet of case parseAddress (E.encodeUtf8 ua) of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-
runFileLoggingT "zenith.log" $ runNoLoggingT $
prepareTx pool zHost zPort znet accId bl amt outUA memo prepareTxV2
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." pool
zHost
zPort
znet
accId
bl
[ ProposedNote
(ValidAddressAPI outUA)
amt
(if memo == ""
then Nothing
else Just memo)
]
policy
case res of case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId
shieldTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> IO ()
shieldTransaction pool chan zHost zPort znet accId bl = do
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
forM_ res $ \case
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId
deshieldTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> ProposedNote
-> IO ()
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
BC.writeBChan chan $ TickMsg "Deshielding funds..."
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <- resp <-
makeZebraCall makeZebraCall
zHost zHost

1264
src/Zenith/Core.hs
View file

File diff suppressed because it is too large Load diff

1638
src/Zenith/DB.hs
View file

File diff suppressed because it is too large Load diff

909
src/Zenith/GUI.hs
View file

File diff suppressed because it is too large Load diff

3
src/Zenith/GUI/Theme.hs
View file

@ -49,6 +49,9 @@ zenithTheme =
L.active . L.active .
L.btnStyle . L.text ?~ L.btnStyle . L.text ?~
baseTextStyle & baseTextStyle &
L.disabled .
L.btnStyle . L.text ?~
baseTextStyle &
L.basic . L.basic .
L.btnMainStyle . L.text ?~ L.btnMainStyle . L.text ?~
hiliteTextStyle & hiliteTextStyle &

953
src/Zenith/RPC.hs Normal file
View file

@ -0,0 +1,953 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
module Zenith.RPC where
import Control.Concurrent (forkIO)
import Control.Exception (try)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
import Data.Aeson
import qualified Data.HexString as H
import Data.Int
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V
import Database.Esqueleto.Experimental
( ConnectionPool
, entityKey
, entityVal
, fromSqlKey
, toSqlKey
)
import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types
( BlockResponse(..)
, RpcError(..)
, Scope(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
( checkBlockChain
, createCustomWalletAddress
, createZcashAccount
, prepareTxV2
, syncWallet
, updateCommitmentTrees
)
import Zenith.DB
( Operation(..)
, ZcashAccount(..)
, ZcashBlock(..)
, ZcashWallet(..)
, completeSync
, finalizeOperation
, findNotesByAddress
, getAccountById
, getAccounts
, getAddressById
, getAddresses
, getExternalAddresses
, getLastSyncBlock
, getMaxAccount
, getMaxAddress
, getMaxBlock
, getMinBirthdayHeight
, getOperation
, getPoolBalance
, getUnconfPoolBalance
, getWalletNotes
, getWallets
, initPool
, isSyncing
, rewindWalletData
, saveAccount
, saveAddress
, saveBlock
, saveOperation
, saveWallet
, startSync
, toZcashAccountAPI
, toZcashAddressAPI
, toZcashWalletAPI
, walletExists
)
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types
( AccountBalance(..)
, Config(..)
, HexStringDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..)
)
import Zenith.Utils (jsonNumber)
data ZenithMethod
= GetInfo
| ListWallets
| ListAccounts
| ListAddresses
| ListReceived
| GetBalance
| GetNewWallet
| GetNewAccount
| GetNewAddress
| GetOperationStatus
| SendMany
| UnknownMethod
deriving (Eq, Prelude.Show)
instance ToJSON ZenithMethod where
toJSON GetInfo = Data.Aeson.String "getinfo"
toJSON ListWallets = Data.Aeson.String "listwallets"
toJSON ListAccounts = Data.Aeson.String "listaccounts"
toJSON ListAddresses = Data.Aeson.String "listaddresses"
toJSON ListReceived = Data.Aeson.String "listreceived"
toJSON GetBalance = Data.Aeson.String "getbalance"
toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
toJSON SendMany = Data.Aeson.String "sendmany"
toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where
parseJSON =
withText "ZenithMethod" $ \case
"getinfo" -> pure GetInfo
"listwallets" -> pure ListWallets
"listaccounts" -> pure ListAccounts
"listaddresses" -> pure ListAddresses
"listreceived" -> pure ListReceived
"getbalance" -> pure GetBalance
"getnewwallet" -> pure GetNewWallet
"getnewaccount" -> pure GetNewAccount
"getnewaddress" -> pure GetNewAddress
"getoperationstatus" -> pure GetOperationStatus
"sendmany" -> pure SendMany
_ -> pure UnknownMethod
data ZenithParams
= BlankParams
| BadParams
| AccountsParams !Int
| AddressesParams !Int
| NotesParams !T.Text
| BalanceParams !Int64
| NameParams !T.Text
| NameIdParams !T.Text !Int
| NewAddrParams !Int !T.Text !Bool !Bool
| OpParams !ZenithUuid
| SendParams !Int ![ProposedNote] !PrivacyPolicy
| TestParams !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithParams where
toJSON BlankParams = Data.Aeson.Array V.empty
toJSON BadParams = Data.Aeson.Null
toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
toJSON (AddressesParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
toJSON (NameParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
toJSON (NameIdParams t i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
toJSON (BalanceParams n) =
Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
toJSON (NewAddrParams a n s t) =
Data.Aeson.Array $
V.fromList $
[jsonNumber a, Data.Aeson.String n] <>
[Data.Aeson.String "ExcludeSapling" | s] <>
[Data.Aeson.String "ExcludeTransparent" | t]
toJSON (OpParams i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
toJSON (SendParams i ns p) =
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
data ZenithResponse
= InfoResponse !T.Text !ZenithInfo
| WalletListResponse !T.Text ![ZcashWalletAPI]
| AccountListResponse !T.Text ![ZcashAccountAPI]
| AddressListResponse !T.Text ![ZcashAddressAPI]
| NoteListResponse !T.Text ![ZcashNoteAPI]
| BalanceResponse !T.Text !AccountBalance !AccountBalance
| NewItemResponse !T.Text !Int64
| NewAddrResponse !T.Text !ZcashAddressAPI
| OpResponse !T.Text !Operation
| SendResponse !T.Text !U.UUID
| ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithResponse where
toJSON (InfoResponse t i) = packRpcResponse t i
toJSON (WalletListResponse i w) = packRpcResponse i w
toJSON (AccountListResponse i a) = packRpcResponse i a
toJSON (AddressListResponse i a) = packRpcResponse i a
toJSON (NoteListResponse i n) = packRpcResponse i n
toJSON (ErrorResponse i c m) =
object
[ "jsonrpc" .= ("2.0" :: String)
, "id" .= i
, "error" .= object ["code" .= c, "message" .= m]
]
toJSON (BalanceResponse i c u) =
packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
toJSON (NewItemResponse i ix) = packRpcResponse i ix
toJSON (NewAddrResponse i a) = packRpcResponse i a
toJSON (OpResponse i u) = packRpcResponse i u
toJSON (SendResponse i o) = packRpcResponse i o
instance FromJSON ZenithResponse where
parseJSON =
withObject "ZenithResponse" $ \obj -> do
jr <- obj .: "jsonrpc"
i <- obj .: "id"
e <- obj .:? "error"
r <- obj .:? "result"
if jr /= ("2.0" :: String)
then fail "Malformed JSON"
else do
case e of
Nothing -> do
case r of
Nothing -> fail "Malformed JSON"
Just r1 ->
case r1 of
Object k -> do
v <- k .:? "version"
v5 <- k .:? "unconfirmed"
v6 <- k .:? "ua"
v7 <- k .:? "uuid"
case (v :: Maybe String) of
Just _v' -> do
k1 <- parseJSON r1
pure $ InfoResponse i k1
Nothing ->
case (v5 :: Maybe AccountBalance) of
Just _v5' -> do
k6 <- parseJSON r1
j1 <- k6 .: "confirmed"
j2 <- k6 .: "unconfirmed"
pure $ BalanceResponse i j1 j2
Nothing ->
case (v6 :: Maybe String) of
Just _v6' -> do
k7 <- parseJSON r1
pure $ NewAddrResponse i k7
Nothing ->
case (v7 :: Maybe U.UUID) of
Just _v7' -> do
k8 <- parseJSON r1
pure $ OpResponse i k8
Nothing -> fail "Unknown object"
Array n -> do
if V.null n
then fail "Malformed JSON"
else do
case V.head n of
Object n' -> do
v1 <- n' .:? "lastSync"
v2 <- n' .:? "wallet"
v3 <- n' .:? "ua"
v4 <- n' .:? "amountZats"
case (v1 :: Maybe Int) of
Just _v1' -> do
k2 <- parseJSON r1
pure $ WalletListResponse i k2
Nothing ->
case (v2 :: Maybe Int) of
Just _v2' -> do
k3 <- parseJSON r1
pure $ AccountListResponse i k3
Nothing ->
case (v3 :: Maybe String) of
Just _v3' -> do
k4 <- parseJSON r1
pure $ AddressListResponse i k4
Nothing ->
case (v4 :: Maybe Int) of
Just _v4' -> do
k5 <- parseJSON r1
pure $ NoteListResponse i k5
Nothing -> fail "Unknown object"
_anyOther -> fail "Malformed JSON"
Number k -> do
case floatingOrInteger k of
Left _e -> fail "Unknown value"
Right k' -> pure $ NewItemResponse i k'
String s -> do
case U.fromText s of
Nothing -> fail "Unknown value"
Just u -> pure $ SendResponse i u
_anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
data ZenithInfo = ZenithInfo
{ zi_version :: !T.Text
, zi_network :: !ZcashNet
, zi_zebra :: !T.Text
} deriving (Eq, Prelude.Show)
instance ToJSON ZenithInfo where
toJSON (ZenithInfo v n z) =
object ["version" .= v, "network" .= n, "zebraVersion" .= z]
instance FromJSON ZenithInfo where
parseJSON =
withObject "ZenithInfo" $ \obj -> do
v <- obj .: "version"
n <- obj .: "network"
z <- obj .: "zebraVersion"
pure $ ZenithInfo v n z
-- | A type to model Zenith RPC calls
data RpcCall = RpcCall
{ jsonrpc :: !T.Text
, callId :: !T.Text
, method :: !ZenithMethod
, parameters :: !ZenithParams
} deriving (Eq, Prelude.Show)
instance ToJSON RpcCall where
toJSON (RpcCall jr i m p) =
object ["jsonrpc" .= jr, "id" .= i, "method" .= m, "params" .= p]
instance FromJSON RpcCall where
parseJSON =
withObject "RpcCall" $ \obj -> do
v <- obj .: "jsonrpc"
i <- obj .: "id"
m <- obj .: "method"
case m of
UnknownMethod -> pure $ RpcCall v i UnknownMethod BlankParams
ListWallets -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i ListWallets BlankParams
else pure $ RpcCall v i ListWallets BadParams
GetInfo -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i GetInfo BlankParams
else pure $ RpcCall v i GetInfo BadParams
ListAccounts -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
w <- parseJSON $ V.head a
pure $ RpcCall v i ListAccounts (AccountsParams w)
else pure $ RpcCall v i ListAccounts BadParams
_anyOther -> pure $ RpcCall v i ListAccounts BadParams
ListAddresses -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i ListAddresses (AddressesParams x)
else pure $ RpcCall v i ListAddresses BadParams
_anyOther -> pure $ RpcCall v i ListAddresses BadParams
ListReceived -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i ListReceived (NotesParams x)
else pure $ RpcCall v i ListReceived BadParams
_anyOther -> pure $ RpcCall v i ListReceived BadParams
GetBalance -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i GetBalance (BalanceParams x)
else pure $ RpcCall v i GetBalance BadParams
_anyOther -> pure $ RpcCall v i GetBalance BadParams
GetNewWallet -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i GetNewWallet (NameParams x)
else pure $ RpcCall v i GetNewWallet BadParams
_anyOther -> pure $ RpcCall v i GetNewWallet BadParams
GetNewAccount -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 2
then do
x <- parseJSON $ a V.! 0
y <- parseJSON $ a V.! 1
pure $ RpcCall v i GetNewAccount (NameIdParams x y)
else pure $ RpcCall v i GetNewAccount BadParams
_anyOther -> pure $ RpcCall v i GetNewAccount BadParams
GetNewAddress -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a >= 2
then do
x <- parseJSON $ a V.! 0
y <- parseJSON $ a V.! 1
(sap, tr) <-
case a V.!? 2 of
Nothing -> return (False, False)
Just s -> do
s' <- parseJSON s
case s' of
("ExcludeSapling" :: String) -> do
case a V.!? 3 of
Nothing -> return (True, False)
Just t -> do
t' <- parseJSON t
return
(True, t' == ("ExcludeTransparent" :: String))
("ExcludeTransparent" :: String) -> do
case a V.!? 3 of
Nothing -> return (False, True)
Just t -> do
t' <- parseJSON t
return
(t' == ("ExcludeSapling" :: String), True)
_anyOther -> return (False, False)
pure $ RpcCall v i GetNewAddress (NewAddrParams x y sap tr)
else pure $ RpcCall v i GetNewAddress BadParams
_anyOther -> pure $ RpcCall v i GetNewAddress BadParams
GetOperationStatus -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ a V.! 0
case U.fromText x of
Just u -> do
pure $
RpcCall v i GetOperationStatus (OpParams $ ZenithUuid u)
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
else pure $ RpcCall v i GetOperationStatus BadParams
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
SendMany -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a >= 2
then do
acc <- parseJSON $ a V.! 0
x <- parseJSON $ a V.! 1
case x of
String _ -> do
x' <- parseJSON $ a V.! 1
y <- parseJSON $ a V.! 2
if not (null y)
then pure $ RpcCall v i SendMany (SendParams acc y x')
else pure $ RpcCall v i SendMany BadParams
Array _ -> do
x' <- parseJSON $ a V.! 1
if not (null x')
then pure $
RpcCall v i SendMany (SendParams acc x' Full)
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
'[ JSON]
RpcCall :> Post '[ JSON] ZenithResponse
data State = State
{ w_network :: !ZcashNet
, w_host :: !T.Text
, w_port :: !Int
, w_dbPath :: !T.Text
, w_build :: !T.Text
, w_startBlock :: !Int
}
zenithServer :: State -> Server ZenithRPC
zenithServer state = getinfo :<|> handleRPC
where
getinfo :: Handler Value
getinfo =
return $
object
[ "version" .= ("0.7.0.0-beta" :: String)
, "network" .= ("testnet" :: String)
]
handleRPC :: Bool -> RpcCall -> Handler ZenithResponse
handleRPC isAuth req =
case method req of
UnknownMethod ->
return $ ErrorResponse (callId req) (-32601) "Method not found"
ListWallets ->
case parameters req of
BlankParams -> do
pool <- liftIO $ runNoLoggingT $ initPool $ w_dbPath state
walList <- liftIO $ getWallets pool $ w_network state
if not (null walList)
then return $
WalletListResponse
(callId req)
(map toZcashWalletAPI walList)
else return $
ErrorResponse
(callId req)
(-32001)
"No wallets available. Please create one first"
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListAccounts ->
case parameters req of
AccountsParams w -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
wl <- liftIO $ walletExists pool w
case wl of
Just wl' -> do
accList <-
liftIO $ runNoLoggingT $ getAccounts pool (entityKey wl')
if not (null accList)
then return $
AccountListResponse
(callId req)
(map toZcashAccountAPI accList)
else return $
ErrorResponse
(callId req)
(-32002)
"No accounts available for this wallet. Please create one first"
Nothing ->
return $
ErrorResponse (callId req) (-32008) "Wallet does not exist."
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListAddresses ->
case parameters req of
AddressesParams a -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
addrList <-
liftIO $
runNoLoggingT $ getAddresses pool (toSqlKey $ fromIntegral a)
if not (null addrList)
then return $
AddressListResponse
(callId req)
(map toZcashAddressAPI addrList)
else return $
ErrorResponse
(callId req)
(-32003)
"No addresses available for this account. Please create one first"
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetInfo ->
case parameters req of
BlankParams ->
return $
InfoResponse
(callId req)
(ZenithInfo "0.7.0.0-beta" (w_network state) (w_build state))
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListReceived ->
case parameters req of
NotesParams x -> do
case (readMaybe (T.unpack x) :: Maybe Int64) of
Just x' -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
a <- liftIO $ getAddressById pool $ toSqlKey x'
case a of
Just a' -> do
nList <- liftIO $ getWalletNotes pool a'
return $ NoteListResponse (callId req) nList
Nothing ->
return $
ErrorResponse
(callId req)
(-32004)
"Address does not belong to the wallet"
Nothing ->
case parseAddress (E.encodeUtf8 x) of
Nothing ->
return $
ErrorResponse
(callId req)
(-32005)
"Unable to parse address"
Just x' -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
addrs <- liftIO $ getExternalAddresses pool
nList <-
liftIO $
concat <$> mapM (findNotesByAddress pool x') addrs
return $ NoteListResponse (callId req) nList
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetBalance ->
case parameters req of
BalanceParams i -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
acc <- liftIO $ getAccountById pool $ toSqlKey i
case acc of
Just acc' -> do
c <- liftIO $ getPoolBalance pool $ entityKey acc'
u <- liftIO $ getUnconfPoolBalance pool $ entityKey acc'
return $ BalanceResponse (callId req) c u
Nothing ->
return $
ErrorResponse (callId req) (-32006) "Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewWallet ->
case parameters req of
NameParams t -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
sP <- liftIO generateWalletSeedPhrase
r <-
liftIO $
saveWallet pool $
ZcashWallet
t
(ZcashNetDB $ w_network state)
(PhraseDB sP)
(w_startBlock state)
0
case r of
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just r' ->
return $
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAccount ->
case parameters req of
NameIdParams t i -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
w <- liftIO $ walletExists pool i
case w of
Just w' -> do
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
nAcc <-
liftIO
(try $ createZcashAccount t (aIdx + 1) w' :: IO
(Either IOError ZcashAccount))
case nAcc of
Left e ->
return $
ErrorResponse (callId req) (-32010) $ T.pack $ show e
Right nAcc' -> do
r <- liftIO $ saveAccount pool nAcc'
case r of
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just x ->
return $
NewItemResponse (callId req) $
fromSqlKey $ entityKey x
Nothing ->
return $
ErrorResponse
(callId req)
(-32008)
"Wallet does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAddress ->
case parameters req of
NewAddrParams i n s t -> do
let dbPath = w_dbPath state
let net = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
case acc of
Just acc' -> do
maxAddr <-
liftIO $ getMaxAddress pool (entityKey acc') External
newAddr <-
liftIO $
createCustomWalletAddress
n
(maxAddr + 1)
net
External
acc'
s
t
dbAddr <- liftIO $ saveAddress pool newAddr
case dbAddr of
Just nAddr -> do
return $
NewAddrResponse
(callId req)
(toZcashAddressAPI nAddr)
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Nothing ->
return $
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetOperationStatus ->
case parameters req of
OpParams u -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
op <- liftIO $ getOperation pool $ getUuid u
case op of
Just o -> do
return $ OpResponse (callId req) $ entityVal o
Nothing ->
return $
ErrorResponse (callId req) (-32009) "Operation ID not found"
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
SendMany ->
case parameters req of
SendParams a ns p -> do
let dbPath = w_dbPath state
let zHost = w_host state
let zPort = w_port state
let znet = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
opid <- liftIO nextRandom
startTime <- liftIO getCurrentTime
opkey <-
liftIO $
saveOperation pool $
Operation
(ZenithUuid opid)
startTime
Nothing
Processing
Nothing
case opkey of
Nothing ->
return $
ErrorResponse (callId req) (-32010) "Internal Error"
Just opkey' -> do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
case acc of
Just acc' -> do
bl <-
liftIO $
getLastSyncBlock
pool
(zcashAccountWalletId $ entityVal acc')
_ <-
liftIO $
forkIO $ do
res <-
liftIO $
runNoLoggingT $
prepareTxV2
pool
zHost
zPort
znet
(entityKey acc')
bl
ns
p
case res of
Left e ->
finalizeOperation pool opkey' Failed $
T.pack $ show e
Right rawTx -> do
zebraRes <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ H.toText rawTx]
case zebraRes of
Left e1 ->
finalizeOperation pool opkey' Failed $
T.pack $ show e1
Right txId ->
finalizeOperation pool opkey' Successful $
"Tx ID: " <> H.toText txId
return $ SendResponse (callId req) opid
Nothing ->
return $
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
authenticate :: Config -> BasicAuthCheck Bool
authenticate config = BasicAuthCheck check
where
check (BasicAuthData username password) =
if username == c_zenithUser config && password == c_zenithPwd config
then return $ Authorized True
else return Unauthorized
packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
scanZebra dbPath zHost zPort net = do
bStatus <- checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool $ ZcashNetDB net
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool
unless syncChk $ do
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do
_ <- startSync pool
mapM_ (processBlock pool) bList
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> do
_ <- completeSync pool Failed
return ()
Right _ -> do
wals <- getWallets pool net
_ <-
runNoLoggingT $
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
runNoLoggingT $
mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals
_ <- completeSync pool Successful
return ()
where
processBlock :: ConnectionPool -> Int -> IO ()
processBlock pool bl = do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
case r of
Left _ -> completeSync pool Failed
Right blk -> do
r2 <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
case r2 of
Left _ -> completeSync pool Failed
Right hb -> do
let blockTime = getBlockTime hb
bi <-
saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB net)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk

198
src/Zenith/Scanner.hs
View file

@ -2,29 +2,28 @@
module Zenith.Scanner where module Zenith.Scanner where
import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import qualified Control.Monad.Catch as CM (try) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( NoLoggingT
, NoLoggingT
, logErrorN , logErrorN
, logInfoN , logInfoN
, runNoLoggingT , runNoLoggingT
, runStderrLoggingT
) )
import Data.Aeson import Data.Aeson
import Data.HexString import Data.HexString
import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time (getCurrentTime) import Data.Time (getCurrentTime)
import Database.Persist.Sqlite import Database.Persist.Sqlite
import GHC.Utils.Monad (concatMapM)
import Lens.Micro ((&), (.~), (^.), set)
import System.Console.AsciiProgress import System.Console.AsciiProgress
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
, RawZebraTx(..) , RawZebraTx(..)
, Transaction(..) , Transaction(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
, ZebraTxResponse(..) , ZebraTxResponse(..)
, fromRawOBundle , fromRawOBundle
@ -32,59 +31,85 @@ import ZcashHaskell.Types
, fromRawTBundle , fromRawTBundle
) )
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain) import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
import Zenith.DB import Zenith.DB
( getMaxBlock ( ZcashBlock(..)
, ZcashBlockId
, clearWalletData
, clearWalletTransactions
, completeSync
, getBlock
, getMaxBlock
, getMinBirthdayHeight
, getUnconfirmedBlocks , getUnconfirmedBlocks
, getWallets
, initDb , initDb
, initPool
, saveBlock
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, startSync
, updateWalletSync
, upgradeQrTable
)
import Zenith.Types
( Config(..)
, HexStringDB(..)
, ZcashNetDB(..)
, ZenithStatus(..)
) )
import Zenith.Utils (jsonNumber) 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 :: rescanZebra ::
Int -- ^ Starting block T.Text -- ^ Host
-> T.Text -- ^ Host
-> Int -- ^ Port -> Int -- ^ Port
-> T.Text -- ^ Path to database file -> T.Text -- ^ Path to database file
-> NoLoggingT IO () -> IO ()
scanZebra b host port dbFilePath = do rescanZebra host port dbFilePath = do
_ <- liftIO $ initDb dbFilePath
startTime <- liftIO getCurrentTime
logInfoN $ "Started sync: " <> T.pack (show startTime)
bc <- bc <-
liftIO $ try $ checkBlockChain host port :: NoLoggingT try $ checkBlockChain host port :: IO
IO
(Either IOError ZebraGetBlockChainInfo) (Either IOError ZebraGetBlockChainInfo)
case bc of case bc of
Left e -> logErrorN $ T.pack (show e) Left e -> print e
Right bStatus -> do Right bStatus -> do
let dbInfo = let znet = ZcashNetDB $ zgb_net bStatus
mkSqliteConnectionInfo dbFilePath & extraPragmas .~ pool1 <- runNoLoggingT $ initPool dbFilePath
["read_uncommited = true"] {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
pool <- createSqlitePoolFromInfo dbInfo 5 {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
dbBlock <- getMaxBlock pool _ <- initDb dbFilePath
upgradeQrTable pool1
clearWalletTransactions pool1
clearWalletData pool1
_ <- startSync pool1
dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1 znet
let sb = max dbBlock b let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then liftIO $ throwIO $ userError "Invalid starting block for scan" then liftIO $ throwIO $ userError "Invalid starting block for scan"
else do else do
liftIO $
print $ print $
"Scanning from " ++ "Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus) let bList = [sb .. (zgb_blocks bStatus)]
let bList = [(sb + 1) .. (zgb_blocks bStatus)] {-
let batch = length bList `div` 3
let bl1 = take batch bList
let bl2 = take batch $ drop batch bList
let bl3 = drop (2 * batch) bList
-}
_ <-
displayConsoleRegions $ do displayConsoleRegions $ do
pg <- pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
liftIO $ {-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
newProgressBar def {pgTotal = fromIntegral $ length bList} {-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
txList <- mapM_ (processBlock host port pool1 pg1 znet) bList
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT {-`concurrently_`-}
IO {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
(Either IOError ()) {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
case txList of print "Please wait..."
Left e1 -> logErrorN $ T.pack (show e1) _ <- completeSync pool1 Successful
Right txList' -> logInfoN "Finished scan" _ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
print "Rescan complete"
-- | Function to process a raw block and extract the transaction information -- | Function to process a raw block and extract the transaction information
processBlock :: processBlock ::
@ -92,9 +117,10 @@ processBlock ::
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> ProgressBar -- ^ Progress bar -> ProgressBar -- ^ Progress bar
-> ZcashNetDB -- ^ the network
-> Int -- ^ The block number to process -> Int -- ^ The block number to process
-> NoLoggingT IO () -> IO ()
processBlock host port pool pg b = do processBlock host port pool pg net b = do
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
@ -103,7 +129,9 @@ processBlock host port pool pg b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1] [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of case r of
Left e -> liftIO $ throwIO $ userError e Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -113,29 +141,30 @@ processBlock host port pool pg b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0] [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
case r2 of case r2 of
Left e2 -> liftIO $ throwIO $ userError e2 Left e2 -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime pool) $ bi <-
bl_txs $ addTime blk blockTime saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
net
mapM_ (processTx host port bi pool) $ bl_txs blk
liftIO $ tick pg liftIO $ tick pg
where
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
-- | Function to process a raw transaction -- | Function to process a raw transaction
processTx :: processTx ::
T.Text -- ^ Host name for `zebrad` T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> Int -- ^ Block time -> ZcashBlockId -- ^ Block ID
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> HexString -- ^ transaction id -> HexString -- ^ transaction id
-> NoLoggingT IO () -> IO ()
processTx host port bt pool t = do processTx host port bt pool t = do
r <- r <-
liftIO $ liftIO $
@ -145,12 +174,15 @@ processTx host port bt pool t = do
"getrawtransaction" "getrawtransaction"
[Data.Aeson.String $ toText t, jsonNumber 1] [Data.Aeson.String $ toText t, jsonNumber 1]
case r of case r of
Left e -> liftIO $ throwIO $ userError e Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right rawTx -> do Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return () Nothing -> return ()
Just rzt -> do Just rzt -> do
_ <- _ <-
runNoLoggingT $
saveTransaction pool bt $ saveTransaction pool bt $
Transaction Transaction
t t
@ -184,3 +216,59 @@ updateConfs host port pool = do
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right blk -> do Right blk -> do
saveConfs pool b $ fromInteger $ bl_confirmations blk saveConfs pool b $ fromInteger $ bl_confirmations blk
clearSync :: Config -> IO ()
clearSync config = do
let zHost = c_zebraHost config
let zPort = c_zebraPort config
let dbPath = c_dbPath config
pool <- runNoLoggingT $ initPool dbPath
bc <-
try $ checkBlockChain zHost zPort :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb dbPath
_ <- upgradeQrTable pool
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zHost zPort dbPath
_ <- clearWalletTransactions pool
w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runNoLoggingT $ mapM (syncWallet config) w'
liftIO $ print r
-- | Detect chain re-orgs
checkIntegrity ::
T.Text -- ^ Database path
-> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port
-> ZcashNet -- ^ the network to scan
-> Int -- ^ The block to start the check
-> Int -- ^ depth
-> IO Int
checkIntegrity dbP zHost zPort znet b d =
if b < 1
then return 1
else do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> do
pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b $ ZcashNetDB znet
case dbBlk of
Nothing -> return 1
Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)

400
src/Zenith/Tree.hs Normal file
View file

@ -0,0 +1,400 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE UndecidableInstances #-}
module Zenith.Tree where
import Codec.Borsh
import Control.Monad.Logger (NoLoggingT, logDebugN)
import Data.HexString
import Data.Int (Int32, Int64, Int8)
import Data.Maybe (fromJust, isNothing)
import qualified Data.Text as T
import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP
import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
import ZcashHaskell.Sapling (combineSaplingNodes, getSaplingNodeValue)
import ZcashHaskell.Types (MerklePath(..), OrchardTree(..), SaplingTree(..))
type Level = Int8
maxLevel :: Level
maxLevel = 32
type Position = Int32
class Monoid v =>
Measured a v
where
measure :: a -> Position -> Int64 -> v
class Node v where
getLevel :: v -> Level
getHash :: v -> HexString
getPosition :: v -> Position
getIndex :: v -> Int64
isFull :: v -> Bool
isMarked :: v -> Bool
mkNode :: Level -> Position -> HexString -> v
type OrchardCommitment = HexString
instance Measured OrchardCommitment OrchardNode where
measure oc p i =
case getOrchardNodeValue (hexBytes oc) of
Nothing -> OrchardNode 0 (hexString "00") 0 True 0 False
Just val -> OrchardNode p val 0 True i False
type SaplingCommitment = HexString
instance Measured SaplingCommitment SaplingNode where
measure sc p i =
case getSaplingNodeValue (hexBytes sc) of
Nothing -> SaplingNode 0 (hexString "00") 0 True 0 False
Just val -> SaplingNode p val 0 True i False
data Tree v
= EmptyLeaf
| Leaf !v
| PrunedBranch !v
| Branch !v !(Tree v) !(Tree v)
| InvalidTree
deriving stock (Eq, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving (BorshSize, ToBorsh, FromBorsh) via AsEnum (Tree v)
instance (Node v, Show v) => Show (Tree v) where
show EmptyLeaf = "()"
show (Leaf v) = "(" ++ show v ++ ")"
show (PrunedBranch v) = "{" ++ show v ++ "}"
show (Branch s x y) =
"<" ++ show (getHash s) ++ ">\n" ++ show x ++ "\n" ++ show y
show InvalidTree = "InvalidTree"
instance (Monoid v, Node v) => Semigroup (Tree v) where
(<>) InvalidTree _ = InvalidTree
(<>) _ InvalidTree = InvalidTree
(<>) EmptyLeaf EmptyLeaf = PrunedBranch $ value $ branch EmptyLeaf EmptyLeaf
(<>) EmptyLeaf x = x
(<>) (Leaf x) EmptyLeaf = branch (Leaf x) EmptyLeaf
(<>) (Leaf x) (Leaf y) = branch (Leaf x) (Leaf y)
(<>) (Leaf _) Branch {} = InvalidTree
(<>) (Leaf _) (PrunedBranch _) = InvalidTree
(<>) (PrunedBranch x) EmptyLeaf = PrunedBranch $ x <> x
(<>) (PrunedBranch x) (Leaf y) =
if isFull x
then InvalidTree
else mkSubTree (getLevel x) (Leaf y)
(<>) (PrunedBranch x) (Branch s t u) =
if getLevel x == getLevel s
then branch (PrunedBranch x) (Branch s t u)
else InvalidTree
(<>) (PrunedBranch x) (PrunedBranch y) = PrunedBranch $ x <> y
(<>) (Branch s x y) EmptyLeaf =
branch (Branch s x y) $ getEmptyRoot (getLevel s)
(<>) (Branch s x y) (PrunedBranch w)
| getLevel s == getLevel w = branch (Branch s x y) (PrunedBranch w)
| otherwise = InvalidTree
(<>) (Branch s x y) (Leaf w)
| isFull s = InvalidTree
| isFull (value x) = branch x (y <> Leaf w)
| otherwise = branch (x <> Leaf w) y
(<>) (Branch s x y) (Branch s1 x1 y1)
| getLevel s == getLevel s1 = branch (Branch s x y) (Branch s1 x1 y1)
| otherwise = InvalidTree
value :: Monoid v => Tree v -> v
value EmptyLeaf = mempty
value (Leaf v) = v
value (PrunedBranch v) = v
value (Branch v _ _) = v
value InvalidTree = mempty
branch :: Monoid v => Tree v -> Tree v -> Tree v
branch x y = Branch (value x <> value y) x y
leaf :: Measured a v => a -> Int32 -> Int64 -> Tree v
leaf a p i = Leaf (measure a p i)
prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v
prunedBranch level pos val = PrunedBranch $ mkNode level pos val
root :: Monoid v => Node v => Tree v -> Tree v
root tree =
if getLevel (value tree) == maxLevel
then tree
else mkSubTree maxLevel tree
getEmptyRoot :: Monoid v => Node v => Level -> Tree v
getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level
append :: Monoid v => Measured a v => Node v => Tree v -> (a, Int64) -> Tree v
append tree (n, i) = tree <> leaf n p i
where
p = 1 + getPosition (value tree)
mkSubTree :: Node v => Monoid v => Level -> Tree v -> Tree v
mkSubTree level t =
if getLevel (value subtree) == level
then subtree
else mkSubTree level subtree
where
subtree = t <> EmptyLeaf
path :: Monoid v => Node v => Position -> Tree v -> Maybe MerklePath
path pos (Branch s x y) =
if length (collectPath (Branch s x y)) /= 32
then Nothing
else Just $ MerklePath pos $ collectPath (Branch s x y)
where
collectPath :: Monoid v => Node v => Tree v -> [HexString]
collectPath EmptyLeaf = []
collectPath Leaf {} = []
collectPath PrunedBranch {} = []
collectPath InvalidTree = []
collectPath (Branch _ j k)
| getPosition (value k) /= 0 && getPosition (value k) < pos = []
| getPosition (value j) < pos = collectPath k <> [getHash (value j)]
| getPosition (value j) >= pos = collectPath j <> [getHash (value k)]
| otherwise = []
path _ _ = Nothing
nullPath :: MerklePath
nullPath = MerklePath 0 []
getNotePosition :: Monoid v => Node v => Tree v -> Int64 -> Maybe Position
getNotePosition (Leaf x) i
| getIndex x == i = Just $ getPosition x
| otherwise = Nothing
getNotePosition (Branch _ x y) i
| getIndex (value x) >= i = getNotePosition x i
| getIndex (value y) >= i = getNotePosition y i
| otherwise = Nothing
getNotePosition _ _ = Nothing
truncateTree :: Monoid v => Node v => Tree v -> Int64 -> NoLoggingT IO (Tree v)
truncateTree (Branch s x y) i
| getLevel s == 1 && getIndex (value x) == i = do
logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to left leaf"
return $ branch x EmptyLeaf
| getLevel s == 1 && getIndex (value y) == i = do
logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to right leaf"
return $ branch x y
| getIndex (value x) >= i = do
logDebugN $
T.pack $
show (getLevel s) ++
": " ++ show i ++ " left i: " ++ show (getIndex (value x))
l <- truncateTree x i
return $ branch (l) (getEmptyRoot (getLevel (value x)))
| getIndex (value y) /= 0 && getIndex (value y) >= i = do
logDebugN $
T.pack $
show (getLevel s) ++
": " ++ show i ++ " right i: " ++ show (getIndex (value y))
r <- truncateTree y i
return $ branch x (r)
| otherwise = do
logDebugN $
T.pack $
show (getLevel s) ++
": " ++
show (getIndex (value x)) ++ " catchall " ++ show (getIndex (value y))
return InvalidTree
truncateTree x _ = return x
countLeaves :: Node v => Tree v -> Int64
countLeaves (Branch s x y) =
if isFull s
then 2 ^ getLevel s
else countLeaves x + countLeaves y
countLeaves (PrunedBranch x) =
if isFull x
then 2 ^ getLevel x
else 0
countLeaves (Leaf _) = 1
countLeaves EmptyLeaf = 0
countLeaves InvalidTree = 0
batchAppend ::
Measured a v
=> Node v => Monoid v => Tree v -> [(Int32, (a, Int64))] -> Tree v
batchAppend x [] = x
batchAppend (Branch s x y) notes
| isFull s = InvalidTree
| isFull (value x) = branch x (batchAppend y notes)
| otherwise =
branch
(batchAppend x (take leftSide notes))
(batchAppend y (drop leftSide notes))
where
leftSide = fromIntegral $ 2 ^ getLevel (value x) - countLeaves x
batchAppend (PrunedBranch k) notes
| isFull k = InvalidTree
| otherwise =
branch
(batchAppend (getEmptyRoot (getLevel k - 1)) (take leftSide notes))
(batchAppend (getEmptyRoot (getLevel k - 1)) (drop leftSide notes))
where
leftSide = fromIntegral $ 2 ^ (getLevel k - 1)
batchAppend EmptyLeaf notes
| length notes == 1 =
leaf (fst $ snd $ head notes) (fst $ head notes) (snd $ snd $ head notes)
| otherwise = InvalidTree
batchAppend _ notes = InvalidTree
data SaplingNode = SaplingNode
{ sn_position :: !Position
, sn_value :: !HexString
, sn_level :: !Level
, sn_full :: !Bool
, sn_index :: !Int64
, sn_mark :: !Bool
} deriving stock (Eq, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct SaplingNode
instance Semigroup SaplingNode where
(<>) x y =
case combineSaplingNodes (sn_level x) (sn_value x) (sn_value y) of
Nothing -> x
Just newHash ->
SaplingNode
(max (sn_position x) (sn_position y))
newHash
(1 + sn_level x)
(sn_full x && sn_full y)
(max (sn_index x) (sn_index y))
(sn_mark x || sn_mark y)
instance Monoid SaplingNode where
mempty = SaplingNode 0 (hexString "00") 0 False 0 False
mappend = (<>)
instance Node SaplingNode where
getLevel = sn_level
getHash = sn_value
getPosition = sn_position
getIndex = sn_index
isFull = sn_full
isMarked = sn_mark
mkNode l p v = SaplingNode p v l True 0 False
instance Show SaplingNode where
show = show . sn_value
saplingSize :: SaplingTree -> Int64
saplingSize tree =
(if isNothing (st_left tree)
then 0
else 1) +
(if isNothing (st_right tree)
then 0
else 1) +
foldl
(\x (i, p) ->
case p of
Nothing -> x + 0
Just _ -> x + 2 ^ i)
0
(zip [1 ..] $ st_parents tree)
mkSaplingTree :: SaplingTree -> Tree SaplingNode
mkSaplingTree tree =
foldl
(\t (i, n) ->
case n of
Just n' -> prunedBranch i 0 n' <> t
Nothing -> t <> getEmptyRoot i)
leafRoot
(zip [1 ..] $ st_parents tree)
where
leafRoot =
case st_right tree of
Just r' -> leaf (fromJust $ st_left tree) (pos - 1) 0 <> leaf r' pos 0
Nothing -> leaf (fromJust $ st_left tree) pos 0 <> EmptyLeaf
pos = fromIntegral $ saplingSize tree - 1
-- | Orchard
data OrchardNode = OrchardNode
{ on_position :: !Position
, on_value :: !HexString
, on_level :: !Level
, on_full :: !Bool
, on_index :: !Int64
, on_mark :: !Bool
} deriving stock (Eq, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardNode
instance Semigroup OrchardNode where
(<>) x y =
case combineOrchardNodes
(fromIntegral $ on_level x)
(on_value x)
(on_value y) of
Nothing -> x
Just newHash ->
OrchardNode
(max (on_position x) (on_position y))
newHash
(1 + on_level x)
(on_full x && on_full y)
(max (on_index x) (on_index y))
(on_mark x || on_mark y)
instance Monoid OrchardNode where
mempty = OrchardNode 0 (hexString "00") 0 False 0 False
mappend = (<>)
instance Node OrchardNode where
getLevel = on_level
getHash = on_value
getPosition = on_position
getIndex = on_index
isFull = on_full
isMarked = on_mark
mkNode l p v = OrchardNode p v l True 0 False
instance Show OrchardNode where
show = show . on_value
instance Measured OrchardNode OrchardNode where
measure o p i =
OrchardNode p (on_value o) (on_level o) (on_full o) i (on_mark o)
orchardSize :: OrchardTree -> Int64
orchardSize tree =
(if isNothing (ot_left tree)
then 0
else 1) +
(if isNothing (ot_right tree)
then 0
else 1) +
foldl
(\x (i, p) ->
case p of
Nothing -> x + 0
Just _ -> x + 2 ^ i)
0
(zip [1 ..] $ ot_parents tree)
mkOrchardTree :: OrchardTree -> Tree OrchardNode
mkOrchardTree tree =
foldl
(\t (i, n) ->
case n of
Just n' -> prunedBranch i 0 n' <> t
Nothing -> t <> getEmptyRoot i)
leafRoot
(zip [1 ..] $ ot_parents tree)
where
leafRoot =
case ot_right tree of
Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0
Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf
pos = fromIntegral $ orchardSize tree - 1

199
src/Zenith/Types.hs
View file

@ -10,23 +10,37 @@
module Zenith.Types where module Zenith.Types where
import Data.Aeson import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Char8 as C
import Data.HexString import Data.HexString
import Data.Int (Int64)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.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 Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U
import Database.Persist.TH import Database.Persist.TH
import GHC.Generics import GHC.Generics
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
import ZcashHaskell.Sapling (encodeSaplingAddress)
import ZcashHaskell.Transparent
( encodeExchangeAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
( OrchardSpendingKey(..) ( ExchangeAddress(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, Rseed(..) , Rseed(..)
, SaplingAddress(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, TransparentAddress(..)
, TransparentSpendingKey , TransparentSpendingKey
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
@ -42,6 +56,9 @@ newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet { getNet :: ZcashNet
} deriving newtype (Eq, Show, Read) } deriving newtype (Eq, Show, Read)
instance ToJSON ZcashNetDB where
toJSON (ZcashNetDB z) = toJSON z
derivePersistField "ZcashNetDB" derivePersistField "ZcashNetDB"
newtype UnifiedAddressDB = UnifiedAddressDB newtype UnifiedAddressDB = UnifiedAddressDB
@ -92,8 +109,165 @@ data Config = Config
{ c_dbPath :: !T.Text { c_dbPath :: !T.Text
, c_zebraHost :: !T.Text , c_zebraHost :: !T.Text
, c_zebraPort :: !Int , c_zebraPort :: !Int
, c_zenithUser :: !BS.ByteString
, c_zenithPwd :: !BS.ByteString
, c_zenithPort :: !Int
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)
data ZcashPool
= TransparentPool
| SproutPool
| SaplingPool
| OrchardPool
deriving (Show, Read, Eq)
derivePersistField "ZcashPool"
instance ToJSON ZcashPool where
toJSON zp =
case zp of
TransparentPool -> Data.Aeson.String "p2pkh"
SproutPool -> Data.Aeson.String "sprout"
SaplingPool -> Data.Aeson.String "sapling"
OrchardPool -> Data.Aeson.String "orchard"
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return TransparentPool
"sprout" -> return SproutPool
"sapling" -> return SaplingPool
"orchard" -> return OrchardPool
_ -> fail "Not a known Zcash pool"
newtype ZenithUuid = ZenithUuid
{ getUuid :: U.UUID
} deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
derivePersistField "ZenithUuid"
-- ** API types
data ZcashWalletAPI = ZcashWalletAPI
{ zw_index :: !Int
, zw_name :: !T.Text
, zw_network :: !ZcashNet
, zw_birthday :: !Int
, zw_lastSync :: !Int
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashWalletAPI)
data ZcashAccountAPI = ZcashAccountAPI
{ za_index :: !Int
, za_wallet :: !Int
, za_name :: !T.Text
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAccountAPI)
data ZcashAddressAPI = ZcashAddressAPI
{ zd_index :: !Int
, zd_account :: !Int
, zd_name :: !T.Text
, zd_ua :: !T.Text
, zd_legacy :: !(Maybe T.Text)
, zd_transparent :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAddressAPI)
data ZcashNoteAPI = ZcashNoteAPI
{ zn_txid :: !HexString
, zn_pool :: !ZcashPool
, zn_amount :: !Float
, zn_amountZats :: !Int64
, zn_memo :: !T.Text
, zn_confirmed :: !Bool
, zn_blockheight :: !Int
, zn_blocktime :: !Int
, zn_outindex :: !Int
, zn_change :: !Bool
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashNoteAPI)
data AccountBalance = AccountBalance
{ acb_transparent :: !Int64
, acb_sapling :: !Int64
, acb_orchard :: !Int64
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)
data ZenithStatus
= Processing
| Failed
| Successful
deriving (Eq, Prelude.Show, Read)
$(deriveJSON defaultOptions ''ZenithStatus)
derivePersistField "ZenithStatus"
data PrivacyPolicy
= None
| Low
| Medium
| Full
deriving (Eq, Show, Read, Ord)
$(deriveJSON defaultOptions ''PrivacyPolicy)
newtype ValidAddressAPI = ValidAddressAPI
{ getVA :: ValidAddress
} deriving newtype (Eq, Show)
instance ToJSON ValidAddressAPI where
toJSON (ValidAddressAPI va) =
case va of
Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
Sapling sa ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeSaplingAddress (net_type sa) (sa_receiver sa))
Transparent ta ->
Data.Aeson.String $
encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
Exchange ea ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeExchangeAddress (ex_network ea) (ex_address ea))
data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI
, pn_amt :: !Scientific
, pn_memo :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
instance FromJSON ProposedNote where
parseJSON =
withObject "ProposedNote" $ \obj -> do
a <- obj .: "address"
n <- obj .: "amount"
m <- obj .:? "memo"
case parseAddress (E.encodeUtf8 a) of
Nothing -> fail "Invalid address"
Just a' ->
if n > 0 && n < 21000000
then pure $ ProposedNote (ValidAddressAPI a') n m
else fail "Invalid amount"
instance ToJSON ProposedNote where
toJSON (ProposedNote a n m) =
object ["address" .= a, "amount" .= n, "memo" .= m]
data ShieldDeshieldOp
= Shield
| Deshield
deriving (Eq, Show, Read, Ord)
-- ** `zebrad` -- ** `zebrad`
-- | Type for modeling the tree state response -- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo data ZebraTreeInfo = ZebraTreeInfo
@ -138,24 +312,6 @@ instance FromJSON AddressSource where
"mnemonic_seed" -> return MnemonicSeed "mnemonic_seed" -> return MnemonicSeed
_ -> fail "Not a known address source" _ -> fail "Not a known address source"
data ZcashPool
= Transparent
| Sprout
| Sapling
| Orchard
deriving (Show, Read, Eq, Generic, ToJSON)
derivePersistField "ZcashPool"
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return Transparent
"sprout" -> return Sprout
"sapling" -> return Sapling
"orchard" -> return Orchard
_ -> fail "Not a known Zcash pool"
data ZcashAddress = ZcashAddress data ZcashAddress = ZcashAddress
{ source :: AddressSource { source :: AddressSource
, pool :: [ZcashPool] , pool :: [ZcashPool]
@ -203,7 +359,8 @@ instance FromJSON AddressGroup where
Nothing -> return [] Nothing -> return []
Just x -> do Just x -> do
x' <- x .:? "addresses" x' <- x .:? "addresses"
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x' return $
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
processSapling k s2 = processSapling k s2 =
case k of case k of
Nothing -> return [] Nothing -> return []
@ -211,7 +368,7 @@ instance FromJSON AddressGroup where
where processOneSapling sx = where processOneSapling sx =
withObject "Sapling" $ \oS -> do withObject "Sapling" $ \oS -> do
oS' <- oS .: "addresses" oS' <- oS .: "addresses"
return $ map (ZcashAddress sx [Sapling] Nothing) oS' return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
processUnified u = processUnified u =
case u of case u of
Nothing -> return [] Nothing -> return []

146
src/Zenith/Utils.hs
View file

@ -3,28 +3,38 @@
module Zenith.Utils where module Zenith.Utils where
import Data.Aeson import Data.Aeson
import Data.Char (isAlphaNum, isSpace)
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Ord (clamp) import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific) 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.Directory
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) import ZcashHaskell.Orchard
( encodeUnifiedAddress
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeExchangeAddress ( decodeExchangeAddress
, decodeTransparentAddress , decodeTransparentAddress
) )
import ZcashHaskell.Types import ZcashHaskell.Types
( SaplingAddress(..) ( ExchangeAddress(..)
, SaplingAddress(..)
, TransparentAddress(..) , TransparentAddress(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Types import Zenith.Types
( AddressGroup(..) ( AddressGroup(..)
, PrivacyPolicy(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
@ -69,9 +79,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
-- | Helper function to validate potential Zcash addresses -- | Helper function to validate potential Zcash addresses
validateAddress :: T.Text -> Maybe ZcashPool validateAddress :: T.Text -> Maybe ZcashPool
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk) validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
| tReg = Just Transparent | tReg = Just TransparentPool
| sReg && chkS = Just Sapling | sReg && chkS = Just SaplingPool
| uReg && chk = Just Orchard | uReg && chk = Just OrchardPool
| otherwise = Nothing | otherwise = Nothing
where where
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@ -83,6 +93,13 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
chkS = isValidShieldedAddress $ E.encodeUtf8 txt chkS = isValidShieldedAddress $ E.encodeUtf8 txt
-- | Return True if Address is valid
validateAddressBool :: T.Text -> Bool
validateAddressBool a = do
case (validateAddress a) of
Nothing -> False
_ -> True
-- | Copy an address to the clipboard -- | Copy an address to the clipboard
copyAddress :: ZcashAddress -> IO () copyAddress :: ZcashAddress -> IO ()
copyAddress a = copyAddress a =
@ -90,12 +107,18 @@ copyAddress a =
createProcess_ "toClipboard" $ createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
-- | Get current user and build zenith path
getZenithPath :: IO String
getZenithPath = do
homeDirectory <- getHomeDirectory
return (homeDirectory ++ "/Zenith/")
-- | Bound a value to the 0..1 range, used for progress reporting on UIs -- | Bound a value to the 0..1 range, used for progress reporting on UIs
validBarValue :: Float -> Float validBarValue :: Float -> Float
validBarValue = clamp (0, 1) validBarValue = clamp (0, 1)
isRecipientValid :: T.Text -> Bool isRecipientValid :: T.Text -> Bool
isRecipientValid a = isRecipientValid a = do
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True Just _a1 -> True
Nothing -> Nothing ->
@ -103,12 +126,84 @@ isRecipientValid a =
(case decodeTransparentAddress (E.encodeUtf8 a) of (case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True Just _a3 -> True
Nothing -> Nothing ->
case decodeExchangeAddress a of case decodeExchangeAddress (E.encodeUtf8 a) of
Just _a4 -> True Just _a4 -> True
Nothing -> False) Nothing -> False)
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress isUnifiedAddressValid :: T.Text -> Bool
parseAddress a znet = isUnifiedAddressValid ua =
case isValidUnifiedAddress (E.encodeUtf8 ua) of
Just _a1 -> True
Nothing -> False
isSaplingAddressValid :: T.Text -> Bool
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
isTransparentAddressValid :: T.Text -> Bool
isTransparentAddressValid ta =
case decodeTransparentAddress (E.encodeUtf8 ta) of
Just _a3 -> True
Nothing -> False
isExchangeAddressValid :: T.Text -> Bool
isExchangeAddressValid xa =
case decodeExchangeAddress (E.encodeUtf8 xa) of
Just _a4 -> True
Nothing -> False
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
isRecipientValidGUI p a = do
let adr = parseAddress (E.encodeUtf8 a)
case p of
Full ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Medium ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Low ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
Transparent ta -> True
_ -> False
Nothing -> False
None ->
case adr of
Just a ->
case a of
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
isZecAddressValid :: T.Text -> Bool
isZecAddressValid a = do
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
Just _a4 -> True
Nothing -> False)
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
parseAddressUA a znet =
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> Just a1 Just a1 -> Just a1
Nothing -> Nothing ->
@ -120,3 +215,36 @@ parseAddress a znet =
Just a3 -> Just a3 ->
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> Nothing Nothing -> Nothing
isValidContent :: String -> Bool
isValidContent [] = False -- an empty string is invalid
isValidContent (x:xs)
| not (isAlphaNum x) = False -- string must start with an alphanumeric character
| otherwise = allValidChars xs -- process the rest of the string
where
allValidChars :: String -> Bool
allValidChars [] = True -- if we got here, string is valid
allValidChars (y:ys)
| isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
| otherwise = False -- found an invalid character, return false
isValidString :: T.Text -> Bool
isValidString c = do
let a = T.unpack c
isValidContent a
padWithZero :: Int -> String -> String
padWithZero n s
| (length s) >= n = s
| otherwise = padWithZero n ("0" ++ s)
isEmpty :: [a] -> Bool
isEmpty [] = True
isEmpty _ = False
getChainTip :: T.Text -> Int -> IO Int
getChainTip zHost zPort = do
r <- makeZebraCall zHost zPort "getblockcount" []
case r of
Left e1 -> pure 0
Right i -> pure i

7
src/Zenith/Zcashd.hs
View file

@ -123,9 +123,10 @@ sendTx user pwd fromAddy toAddy amount memo = do
if source fromAddy /= ImportedWatchOnly if source fromAddy /= ImportedWatchOnly
then do then do
let privacyPolicy let privacyPolicy
| valAdd == Just Transparent = "AllowRevealedRecipients" | valAdd == Just TransparentPool = "AllowRevealedRecipients"
| isNothing (account fromAddy) && | isNothing (account fromAddy) &&
elem Transparent (pool fromAddy) = "AllowRevealedSenders" elem TransparentPool (pool fromAddy) =
"AllowRevealedSenders"
| otherwise = "AllowRevealedAmounts" | otherwise = "AllowRevealedAmounts"
let pd = let pd =
case memo of case memo of
@ -301,7 +302,7 @@ sendWithUri user pwd fromAddy uri repTo = do
let addType = validateAddress $ T.pack parsedAddress let addType = validateAddress $ T.pack parsedAddress
case addType of case addType of
Nothing -> putStrLn " Invalid address" Nothing -> putStrLn " Invalid address"
Just Transparent -> do Just TransparentPool -> do
putStrLn $ " Address is valid: " ++ parsedAddress putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount." Nothing -> putStrLn " Invalid amount."

754
test/ServerSpec.hs Normal file
View file

@ -0,0 +1,754 @@
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (SomeException, throwIO, try)
import Control.Monad (when)
import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson
import qualified Data.ByteString as BS
import Data.Configurator
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
import qualified Data.UUID as U
import Network.HTTP.Simple
import Network.Wai.Handler.Warp (run)
import Servant
import System.Directory
import Test.HUnit hiding (State)
import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
import ZcashHaskell.Types
( ZcashNet(..)
, ZebraGetBlockChainInfo(..)
, ZebraGetInfo(..)
)
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (Operation(..), initDb, initPool, saveOperation)
import Zenith.RPC
( RpcCall(..)
, State(..)
, ZenithInfo(..)
, ZenithMethod(..)
, ZenithParams(..)
, ZenithRPC(..)
, ZenithResponse(..)
, authenticate
, zenithServer
)
import Zenith.Types
( Config(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..)
)
main :: IO ()
main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"]
let dbFilePath = "test.db"
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
nodePort <- require config "nodePort"
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
hspec $ do
describe "RPC methods" $ do
beforeAll_ (startAPI myConfig) $ do
describe "getinfo" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
GetInfo
BlankParams
res `shouldBe` Left "Invalid credentials"
it "correct credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetInfo
BlankParams
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
InfoResponse "zh" (ZenithInfo "0.7.0.0-beta" TestNet "v1.9.0")
describe "Wallets" $ do
describe "listwallet" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
ListWallets
BlankParams
res `shouldBe` Left "Invalid credentials"
it "correct credentials, no wallet" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListWallets
BlankParams
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32001)
"No wallets available. Please create one first"
describe "getnewwallet" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
GetNewWallet
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "no params" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewWallet
BlankParams
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe` ErrorResponse "zh" (-32602) "Invalid params"
it "Valid params" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewWallet
(NameParams "Main")
case res of
Left e -> assertFailure e
Right r -> r `shouldBe` NewItemResponse "zh" 1
it "duplicate name" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewWallet
(NameParams "Main")
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32007)
"Entity with that name already exists."
describe "listwallet" $ do
it "wallet exists" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListWallets
BlankParams
case res of
Left e -> assertFailure e
Right (WalletListResponse i k) ->
zw_name (head k) `shouldBe` "Main"
Right _ -> assertFailure "Unexpected response"
describe "Accounts" $ do
describe "listaccounts" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
ListAccounts
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid wallet" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListAccounts
(AccountsParams 17)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse "zh" (-32008) "Wallet does not exist."
it "valid wallet, no accounts" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListAccounts
(AccountsParams 1)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32002)
"No accounts available for this wallet. Please create one first"
describe "getnewaccount" $ do
it "invalid credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
GetNewAccount
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid wallet" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAccount
(NameIdParams "Personal" 17)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse "zh" (-32008) "Wallet does not exist."
it "valid wallet" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAccount
(NameIdParams "Personal" 1)
case res of
Left e -> assertFailure e
Right r -> r `shouldBe` NewItemResponse "zh" 1
it "valid wallet, duplicate name" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAccount
(NameIdParams "Personal" 1)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32007)
"Entity with that name already exists."
describe "listaccounts" $ do
it "valid wallet" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListAccounts
(AccountsParams 1)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
AccountListResponse "zh" [ZcashAccountAPI 1 1 "Personal"]
describe "Addresses" $ do
describe "listaddresses" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
ListAddresses
BlankParams
res `shouldBe` Left "Invalid credentials"
it "correct credentials, no addresses" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListAddresses
(AddressesParams 1)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32003)
"No addresses available for this account. Please create one first"
describe "getnewaddress" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
GetNewAddress
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid account" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAddress
(NewAddrParams 17 "Business" False False)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse "zh" (-32006) "Account does not exist."
it "valid account" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAddress
(NewAddrParams 1 "Business" False False)
case res of
Left e -> assertFailure e
Right (NewAddrResponse i a) -> zd_name a `shouldBe` "Business"
Right _ -> assertFailure "unexpected response"
it "valid account, duplicate name" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAddress
(NewAddrParams 1 "Business" False False)
case res of
Left e -> assertFailure e
Right r ->
r `shouldBe`
ErrorResponse
"zh"
(-32007)
"Entity with that name already exists."
it "valid account, no sapling" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAddress
(NewAddrParams 1 "NoSapling" True False)
case res of
Left e -> assertFailure e
Right (NewAddrResponse i a) -> zd_legacy a `shouldBe` Nothing
Right _ -> assertFailure "unexpected response"
it "valid account, no transparent" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAddress
(NewAddrParams 1 "NoTransparent" False True)
case res of
Left e -> assertFailure e
Right (NewAddrResponse i a) ->
zd_transparent a `shouldBe` Nothing
Right _ -> assertFailure "unexpected response"
it "valid account, orchard only" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetNewAddress
(NewAddrParams 1 "OrchOnly" True True)
case res of
Left e -> assertFailure e
Right (NewAddrResponse i a) ->
a `shouldSatisfy`
(\b ->
(zd_transparent b == Nothing) && (zd_legacy b == Nothing))
Right _ -> assertFailure "unexpected response"
describe "listaddresses" $ do
it "correct credentials, addresses exist" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListAddresses
(AddressesParams 1)
case res of
Left e -> assertFailure e
Right (AddressListResponse i a) -> length a `shouldBe` 4
describe "Notes" $ do
describe "listreceived" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
ListReceived
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "no parameters" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListReceived
BlankParams
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
it "unknown index" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
ListReceived
(NotesParams "17")
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32004)
describe "Balance" $ do
describe "getbalance" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
GetBalance
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "no parameters" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetBalance
BlankParams
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
it "unknown index" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetBalance
(BalanceParams 17)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
describe "Operations" $ do
describe "getoperationstatus" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
GetOperationStatus
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid ID" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetOperationStatus
(NameParams "badId")
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
it "valid ID" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetOperationStatus
(OpParams
(ZenithUuid $
fromMaybe U.nil $
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4"))
case res of
Left e -> assertFailure e
Right (OpResponse i o) ->
operationUuid o `shouldBe`
(ZenithUuid $
fromMaybe U.nil $
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
Right _ -> assertFailure "unexpected response"
it "valid ID not found" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
GetOperationStatus
(OpParams
(ZenithUuid $
fromMaybe U.nil $
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a5"))
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
Right _ -> assertFailure "unexpected response"
describe "Send tx" $ do
describe "sendmany" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
SendMany
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid account" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
17
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(Just "A cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
it "valid account, empty notes" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams 1 [] Full)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
it "valid account, single output" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
1
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
5.0
(Just "A cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (SendResponse i o) -> o `shouldNotBe` U.nil
it "valid account, multiple outputs" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
let uaRead2 =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
1
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
5.0
(Just "A cool memo")
, ProposedNote
(ValidAddressAPI $ fromJust uaRead2)
1.0
(Just "Not so cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (SendResponse i o) -> o `shouldNotBe` U.nil
startAPI :: Config -> IO ()
startAPI config = do
putStrLn "Starting test RPC server"
checkDbFile <- doesFileExist "test.db"
when checkDbFile $ removeFile "test.db"
let ctx = authenticate config :. EmptyContext
w <-
try $ checkZebra (c_zebraHost config) (c_zebraPort config) :: IO
(Either IOError ZebraGetInfo)
case w of
Right zebra -> do
bc <-
try $ checkBlockChain (c_zebraHost config) (c_zebraPort config) :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb "test.db"
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
pool <- runNoLoggingT $ initPool "test.db"
ts <- getCurrentTime
y <-
saveOperation
pool
(Operation
(ZenithUuid $
fromMaybe U.nil $
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
ts
Nothing
Processing
Nothing)
let myState =
State
(zgb_net chainInfo)
(c_zebraHost config)
(c_zebraPort config)
"test.db"
(zgi_build zebra)
(zgb_blocks chainInfo)
forkIO $
run (c_zenithPort config) $
serveWithContext
(Servant.Proxy :: Servant.Proxy ZenithRPC)
ctx
(zenithServer myState)
threadDelay 1000000
putStrLn "Test server is up!"
-- | Make a Zebra RPC call
makeZenithCall ::
T.Text -- ^ Hostname for `zebrad`
-> Int -- ^ Port for `zebrad`
-> BS.ByteString
-> BS.ByteString
-> ZenithMethod -- ^ RPC method to call
-> ZenithParams -- ^ List of parameters
-> IO (Either String ZenithResponse)
makeZenithCall host port usr pwd m params = do
let payload = RpcCall "2.0" "zh" m params
let myRequest =
setRequestBodyJSON payload $
setRequestPort port $
setRequestHost (E.encodeUtf8 host) $
setRequestBasicAuth usr pwd $ setRequestMethod "POST" defaultRequest
r <- httpJSONEither myRequest
case getResponseStatusCode r of
403 -> return $ Left "Invalid credentials"
200 ->
case getResponseBody r of
Left e -> return $ Left $ show e
Right r' -> return $ Right r'
e -> return $ Left $ show e ++ show (getResponseBody r)

1010
test/Spec.hs
View file

File diff suppressed because it is too large Load diff

2
zcash-haskell

@ -1 +1 @@
Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2 Subproject commit d45bd7dcf3c3cf4e893900a1774d24b14bf56591

900
zenith-openrpc.json Normal file
View file

@ -0,0 +1,900 @@
{
"openrpc": "1.0.0-rc1",
"info": {
"version": "0.7.0.0-beta",
"title": "Zenith RPC",
"description": "The RPC methods to interact with the Zenith Zcash wallet",
"license": {
"name": "MIT",
"url": "https://choosealicense.com/licenses/mit/"
}
},
"servers": [
{
"name": "Zenith RPC",
"summary": "The Zenith wallet RPC server",
"description": "This is the server that allows programmatic interaction with the Zenith Zcash wallet via RPC",
"url": "http://localhost:8234"
}
],
"methods": [
{
"name": "getinfo",
"summary": "Get basic Zenith information",
"description": "Get basic information about Zenith, such as the network it is running on and the version of Zebra it is connected to",
"tags": [],
"result" : {
"name": "Zenith information",
"schema": { "$ref": "#/components/schemas/ZenithInfo" }
},
"params" : [],
"examples": [
{
"name": "GetInfo example",
"summary": "Get information from Zenith",
"description": "Gets the status of the Zenith wallet server",
"params": [],
"result": {
"name": "GetInfo result",
"value": {
"version": "0.7.0.0-beta",
"network": "TestNet",
"zebraVersion": "v1.8.0"
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }
]
},
{
"name": "listwallets",
"summary": "Get the list of available wallets",
"description": "Returns a list of available wallets per the network that the Zebra node is running on.",
"tags": [],
"result": {
"name": "Wallets",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashWallet"
}
}
},
"params": [],
"examples": [
{
"name": "ListWallets example",
"summary": "Get list of wallets",
"description": "Get the list of wallets available in Zenith for the current network (Mainnet/Testnet)",
"params": [],
"result": {
"name": "ListWallets result",
"value": [
{
"birthday": 2762066,
"index": 1,
"lastSync": 2919374,
"name": "Main",
"network": "TestNet"
},
{
"birthday": 2798877,
"index": 2,
"lastSync": 2894652,
"name": "zcashd",
"network": "TestNet"
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/NoWallets" }
]
},
{
"name": "getnewwallet",
"summary": "Create a new wallet",
"description": "Create a new wallet for Zenith.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/Name"}
],
"paramStructure": "by-position",
"result": {
"name": "Wallet",
"schema": {
"$ref": "#/components/contentDescriptors/WalletId"
}
},
"examples": [
{
"name": "GetNewWallet example",
"summary": "Create a wallet",
"description": "Creates a new wallet with the given name",
"params": [
{
"name": "Wallet name",
"summary": "The user-friendly name for the wallet",
"value": "Main"
}
],
"result": {
"name": "GetNewWallet result",
"value": 1
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" }
]
},
{
"name": "listaccounts",
"summary": "List existing accounts for a wallet ID",
"description": "List existing accounts for the given wallet ID or provide an error if none",
"tags": [],
"result": {
"name": "Accounts",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashAccount"
}
}
},
"params": [{ "$ref": "#/components/contentDescriptors/WalletId"}],
"paramStructure": "by-position",
"examples": [
{
"name": "ListAccounts example",
"summary": "Get list of accounts",
"description": "Get the list of accounts available in Zenith for the given wallet ID",
"params": [
{
"name": "walletId",
"summary": "The integer ID of the wallet to use",
"value": 1
}
],
"result": {
"name": "ListAccounts result",
"value": [
{
"index": 3,
"name": "Business",
"wallet": 1
},
{
"index": 1,
"name": "Savings",
"wallet": 1
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/NoAccounts" }
]
},
{
"name": "getnewaccount",
"summary": "Create a new account",
"description": "Create a new account in the given wallet.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/Name"},
{ "$ref": "#/components/contentDescriptors/WalletId"}
],
"paramStructure": "by-position",
"result": {
"name": "Account",
"schema": {
"$ref": "#/components/contentDescriptors/AccountId"
}
},
"examples": [
{
"name": "GetNewAccount example",
"summary": "Create an account",
"description": "Creates a new account with the given name",
"params": [
{
"name": "Account name",
"summary": "The user-friendly name for the Account",
"value": "Personal"
},
{
"name": "Wallet Id",
"summary": "The internal index of the Wallet to use",
"value": 1
}
],
"result": {
"name": "GetNewAccount result",
"value": 1
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/DuplicateName" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidWallet" }
]
},
{
"name": "listaddresses",
"summary": "List existing addresses for an account ID",
"description": "List existing addresses for the given account ID or provide an error if none",
"tags": [],
"result": {
"name": "Addresses",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashAddress"
}
}
},
"params": [{ "$ref": "#/components/contentDescriptors/AccountId"}],
"paramStructure": "by-position",
"examples": [
{
"name": "ListAddresses example",
"summary": "Get list of addresses",
"description": "Get the list of addresses available in Zenith for the given account ID",
"params": [
{
"name": "accountId",
"summary": "The integer ID of the account to use",
"value": 1
}
],
"result": {
"name": "ListAddresses result",
"value": [
{
"index": 3,
"account": 1,
"name": "Clothes",
"ua": "utest13dq4u4dnf3yddw8lq2n6zdclshra6xsp8zgkc5ydyu6k20zrsscmuex46qa4vh84rgd78sqnlleapznnz7mnzx9wv0unts8pv32paj8se5ca3kves2u4a89uy6e8cf4hnarxydxh7hq2e9uu39punfmm53k5h45xn9k3dx35la8j7munh9td7774m8gkqgc4mn40t69w20uu2gtks7a",
"legacy": "ztestsapling188csdsvhdny25am8ume03qr2026hdy03zpg5pq7jmmfxtxtct0e93p0rg80yfxvynqd4gwlwft5",
"transparent": "tmMouLwVfRYrF91fWjDJToivmsTWBhxfX4E"
},
{
"index": 2,
"account": 1,
"name": "Vacation",
"ua": "utest1hhggl4nxfdx63evps6r7qz50cgacgtdpt9k7dl0734w63zn5qmrp6c2xdv9rkqyfkj6kgau4kz48xtm80e67l534qp02teqq86zuzetxql6z5v32yglg9n2un5zsu0hwcvaunzdfg5qnry6syh2dh9x8eu27de03j9pjfvrqda6acgtc6f0emdfh6r5jvfanmjml4ms5wwj9wfqmamq",
"legacy": "ztestsapling1mpup3xv2k9clxaf9wjcr0dt5gnmkprz9s9qsn298mqs356pf39wmh30q3pgsp0w5vyrmj6mrzw2",
"transparent": "tmX8qCB96Dq49YZkww3bSty7eZDA4Fq6F4R"
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/NoAddress" }
]
},
{
"name": "getnewaddress",
"summary": "Add a new address",
"description": "Derive a new address in the given account.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/Name"},
{ "$ref": "#/components/contentDescriptors/ExcludeSapling"},
{ "$ref": "#/components/contentDescriptors/ExcludeTransparent"}
],
"result": {
"name": "Address",
"schema": {
"$ref": "#/components/schemas/ZcashAddress"
}
},
"examples": [
{
"name": "GetNewAddress example",
"summary": "Get a new address for the given account",
"description": "Get a new address for the given account with an Orchard receiver, a Sapling receiver and a transparent receiver (default)",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "AllRecvs"
}
],
"result":
{
"name": "Default receivers",
"value": {
"index": 14,
"account": 1,
"name": "AllRecvs",
"ua": "utest1as2fhusjt5r7xl8963jnkkums6gue6qvu7fpw2cvrctwnwrku9r4av9zmmjt7mmet927cq9z4z0hq2w7tpm7qa8lzl5fyj6d83un6v3q78c76j7thpuzyzr260apm8xvjua5fvmrfzy59mpurec7tfamp6nd6eq95pe8vzm69hfsfea29u4v3a6lyuaah20c4k6rvf9skz35ct2r54z",
"legacy": "ztestsapling1esn0wamf8w3nz2juwryscc3l8e5xtll6aewx0r2h5xtmrpnzsw2k23lec65agn8v59r72v2krrh",
"transparent": "tmMteg5HxFnmn4mbm2UNEGzWgLX16bGLg16"
}
}
},
{
"name": "GetNewAddress - no transparent",
"summary": "Get a new address for the given account with no transparent receiver",
"description": "Get a new address for the given account with an Orchard receiver, a Sapling receiver and *no* transparent receiver (default)",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "NoTransparent"
},
{
"name": "ExcludeTransparent",
"summary": "Option to exclude transparent receivers from the address",
"value": "ExcludeTransparent"
}
],
"result":
{
"name": "NoTransparent",
"value": {
"index": 15,
"account": 1,
"name": "NoTransparent",
"ua": "utest1l0t3uzadaxa4jg7qatsfwqdvfp0qtedyyall65hm2nzwnwdmcvd7j4z6wdrftpsjxv8aw4qh0hka3wdqj0z48xrhg356dlapy36ug6tt20tkzavwccjfup8wy8sdkcc60rpf400mwek73n0ph9jyw9ae60rm5jt8rx75nzhyuymern2t",
"legacy": "ztestsapling1vp3kzw7rqldfvaw5edfgqq66qm0xnexmscwnys220403mqqh9uyl0sqsye37aelrese42y8ecnx",
"transparent": null
}
}
},
{
"name": "GetNewAddress - no Sapling",
"summary": "Get a new address for the given account with no Sapling receiver",
"description": "Get a new address for the given account with an Orchard receiver and a transparent receiver, and *no* Sapling receiver.",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "NoSapling"
},
{
"name": "ExcludeSapling",
"summary": "Option to exclude Sapling receivers from the address",
"value": "ExcludeSapling"
}
],
"result":
{
"name": "NoSapling",
"value": {
"index": 16,
"account": 3,
"name": "NoSapling",
"ua": "utest14yvw4msvn9r5nggv2s0yye8phqwrhsx8ddfvpg30zp4gtf928myaua8jwxssl7frr8eagvcrsa8tuu9dlh7cvksv3lkudvyrq2ysrtzate0dud7x0zhgz26wqccn8w7346v4kfagv3e",
"legacy": null,
"transparent": "tmQ7z6q46NLQXpeNkfeRL6wJwJWA4picf6b"
}
}
},
{
"name": "GetNewAddress - Orchard only",
"summary": "Get a new address for the given account with only an Orchard receiver",
"description": "Get a new address for the given account with an Orchard receiver and *no* transparent receiver, and *no* Sapling receiver.",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "OrchardOnly"
},
{
"name": "ExcludeSapling",
"summary": "Option to exclude Sapling receivers from the address",
"value": "ExcludeSapling"
},
{
"name": "ExcludeTransparent",
"summary": "Option to exclude transparent receivers from the address",
"value": "ExcludeTransparent"
}
],
"result":
{
"name": "OrchardOnly",
"value": {
"index": 17,
"account": 3,
"name": "OrchardOnly",
"ua": "utest1890l0xjxcsapk0u7jnqdglzwp04rt4r8zfvh7qx6a76fq96fyxg9xysvklwjymm9xuxzk0578pvv3yzv0w8l5x4run96mahky5defw0m",
"legacy": null,
"transparent": null
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/InvalidAccount" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" }
]
},
{
"name": "getbalance",
"summary": "Get the balance of the given account",
"description": "Get the balance of the given account, including any unconfirmed balance.",
"tags": [],
"params": [{ "$ref": "#/components/contentDescriptors/AccountId"}],
"result": {
"name": "Balance",
"schema": {
"type": "object",
"properties": {
"confirmed": {"$ref": "#/components/schemas/Balance" },
"unconfirmed": {"$ref": "#/components/schemas/Balance" }
}
}
},
"examples": [
{
"name": "GetBalance example",
"summary": "Get account balance",
"description": "Provides the balance for the current account, showing the balance for the transparent, Sapling and Orchard pools, both for confirmed notes and unconfirmed notes",
"params": [
{
"name": "accountId",
"summary": "The integer ID of the account to use",
"value": 1
}
],
"result": {
"name": "GetBalance result",
"value":{
"confirmed": {
"orchard": 22210259,
"sapling": 0,
"transparent": 0
},
"unconfirmed": {
"orchard": 0,
"sapling": 0,
"transparent": 0
}
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/InvalidAccount" }
]
},
{
"name": "listreceived",
"summary": "List received transactions",
"description": "List transactions received by the given address.",
"tags": [],
"params": [{ "$ref": "#/components/contentDescriptors/Address"}],
"paramStructure": "by-position",
"result": {
"name": "Transactions",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashNote"
}
}
},
"examples": [
{
"name": "ListReceived by Id",
"summary": "Get list of notes received by the address ID",
"description": "Provides the list of notes received by the address identified by the index provided as a parameter",
"params": [
{
"name": "Address index",
"summary": "The index for the address to use",
"value": "1"
}
],
"result": {
"name": "ListReceived by Id result",
"value": [
{
"txid": "987fcdb9bd37cbb5b205a8336de60d043f7028bebaa372828d81f3da296c7ef9",
"pool": "p2pkh",
"amount": 0.13773064,
"amountZats": 13773064,
"memo": "",
"confirmed": true,
"blockheight": 2767099,
"blocktime": 1711132723,
"outindex": 0,
"change": false
},
{
"txid": "186bdbc64f728c9d0be96082e946a9228153e24a70e20d8a82f0601da679e0c2",
"pool": "orchard",
"amount": 0.0005,
"amountZats": 50000,
"memo": "<22>",
"confirmed": true,
"blockheight": 2801820,
"blocktime": 1713399060,
"outindex": 0,
"change": false
}
]
}
},
{
"name": "ListReceived by Address",
"summary": "Get list of notes received by the address",
"description": "Provides the list of notes received by the address provided as a parameter",
"params": [
{
"name": "Address",
"summary": "The address to use",
"value": "ztestsapling1mpup3xv2k9clxaf9wjcr0dt5gnmkprz9s9qsn298mqs356pf39wmh30q3pgsp0w5vyrmj6mrzw2"
}
],
"result": {
"name": "ListReceived by Address result",
"value": [
{
"txid": "2a104393d72d1e62c94654950a92931e786a1f04aa732512597638b5c4a69a91",
"pool": "sapling",
"amount": 0.11447195,
"amountZats": 11447195,
"memo": "<22>",
"confirmed": true,
"blockheight": 2800319,
"blocktime": 1713301802,
"outindex": 0,
"change": false
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/UnknownAddress" },
{ "$ref": "#/components/errors/InvalidAddress" }
]
},
{
"name": "sendmany",
"summary": "Send transaction(s)",
"description": "Send one transaction by specifying the source account, the privacy policy (optional, default 'Full') and an array of proposed outputs. Each output needs a recipient address, an amount and an optional shielded memo.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
{ "$ref": "#/components/contentDescriptors/TxRequestArray"}
],
"paramStructure": "by-position",
"result": {
"name": "Operation ID(s)",
"schema": {
"type": "array",
"items": { "$ref": "#/components/contentDescriptors/OperationId"}
}
},
"examples": [
{
"name": "Send a transaction",
"summary": "Send a transaction",
"description": "Send a transaction with one output",
"params": [
{
"name": "Account index",
"summary": "The index for the account to use",
"value": "1"
},
{
"name": "Privacy Policy",
"summary": "The selected privacy policy",
"value": "Full"
},
{
"name": "Transaction request",
"summary": "The transaction to attempt",
"value": [
{
"address": "utest13dq4u4dnf3yddw8lq2n6zdclshra6xsp8zgkc5ydyu6k20zrsscmuex46qa4vh84rgd78sqnlleapznnz7mnzx9wv0unts8pv32paj8se5ca3kves2u4a89uy6e8cf4hnarxydxh7hq2e9uu39punfmm53k5h45xn9k3dx35la8j7munh9td7774m8gkqgc4mn40t69w20uu2gtks7a",
"amount": 2.45,
"memo": "Simple transaction"
}
]
}
],
"result": {
"name": "SendMany result",
"value": [
"3cc31c07-07cf-4a6e-9190-156c4b8c4088"
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidAccount" }
]
},
{
"name": "getoperationstatus",
"summary": "Get the status of a Zenith operation",
"description": "Get the status of the given operation",
"tags": [],
"params": [{ "$ref": "#/components/contentDescriptors/OperationId"}],
"paramStructure": "by-position",
"result": {
"name": "Operation",
"schema": {
"$ref": "#/components/schemas/Operation"
}
},
"errors": [
{ "$ref": "#/components/errors/OpNotFound" }
]
}
],
"components": {
"contentDescriptors": {
"WalletId": {
"name": "Wallet ID",
"summary": "The wallet's internal index used for unique identification",
"description": "An Integer value that uniquely identifies a wallet in Zenith",
"required": true,
"schema": {
"type": "integer"
}
},
"AccountId": {
"name": "Account ID",
"summary": "The account's internal index used for unique identification",
"description": "An Integer value that uniquely identifies an account in Zenith",
"required": true,
"schema": {
"type": "integer"
}
},
"Address": {
"name": "Address identifier",
"summary": "The address identifier",
"description": "A string that identifies a specific address, either by its index or the [ZIP-316](https://zips.z.cash/zip-0316) encoded address itself",
"required": true,
"schema": {
"type": "string"
}
},
"Name": {
"name": "Name",
"summary": "A user-friendly name",
"description": "A string that represents an entity in Zenith, like a wallet, an account or an address.",
"required": true,
"schema": {
"type": "string"
}
},
"ExcludeSapling": {
"name": "ExcludeSapling",
"summary": "Setting that indicates that the new address requested should not contain a Sapling component",
"description": "When this parameter is present, Zenith will generate an address with no Sapling receiver",
"required": false,
"schema" : {
"type": "string"
}
},
"ExcludeTransparent": {
"name": "ExcludeTransparent",
"summary": "Setting that indicates that the new address requested should not contain a Transparent component",
"description": "When this parameter is present, Zenith will generate an address with no Transparent receiver",
"required": false,
"schema" : {
"type": "string"
}
},
"OperationId": {
"name": "Operation ID",
"summary": "A unique identifier for Zenith operations",
"description": "A [UUID](http://en.wikipedia.org/wiki/UUID) assigned to an operation (like sending a transaction) that can be used to query Zenith to see the status and outcome of the operation.",
"required": true,
"schema" : {
"type": "string"
}
},
"TxRequestArray": {
"name": "Transaction Request Array",
"summary": "An array of proposed transactions",
"description": "An array of proposed new outgoing transactions, including the recipient's address, the amount in ZEC, the optional shielded memo, and the optional privacy level.",
"required": true,
"schema": {
"type": "array",
"items": { "$ref": "#/components/schemas/TxRequest"}
}
},
"PrivacyPolicy": {
"name": "Privacy Policy",
"summary": "The chosen privacy policy to use for the transaction",
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
"required": false,
"schema": {
"type": "string",
"enum": ["None", "Low", "Medium", "Full"]
}
}
},
"schemas": {
"ZenithInfo": {
"type": "object",
"properties": {
"version": { "type": "string", "description": "Zenith's version"},
"network": { "type": "string", "description": "The network the wallet is connected to"},
"zebraVersion": { "type": "string", "description": "The version of the Zebra node used by Zenith"}
}
},
"ZcashWallet": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index of wallet"},
"name": { "type": "string", "description": "User-friendly name of the wallet" },
"network": { "type": "string", "description": "Network the wallet is for. Testnet or MainNet" },
"birthday": { "type": "integer", "description": "Wallet's birthday height" },
"lastSync": { "type": "integer", "description": "Last block the wallet is synced to" }
}
},
"ZcashAccount": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index for account"},
"wallet": { "type": "integer", "description": "ID of the wallet this account belongs to"},
"name": { "type": "string", "description": "User-friendly name of the account"}
}
},
"ZcashAddress": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index for address"},
"account": { "type": "integer", "description": "ID of the account this address belongs to"},
"name": { "type": "string", "description": "User-friendly name of the address"},
"ua": { "type": "string", "description": "Unified address"},
"legacy": { "type": "string", "description": "Legacy Sapling address"},
"transparent": { "type": "string", "description": "Transparent address"}
}
},
"ZcashNote": {
"type": "object",
"properties": {
"txid": { "type": "string", "description": "Transaction ID"},
"pool": { "type": "string", "description": "Orchard, Sapling, or Transparent" },
"amount" : { "type": "number", "description": "The amount of the note in ZEC"},
"amountZats": { "type": "integer", "description": "The amount of the note in zats"},
"memo": { "type": "string", "description": "The memo corresponding to the note, if any"},
"confirmed": { "type": "boolean", "description": "If the note is confirmed per the thresholds in the configuration"},
"blockheight": { "type": "integer", "description": "The block height containing the transaction"},
"blocktime": { "type": "integer", "description": "The transaction time in seconds since epoch"},
"outindex": { "type": "integer", "description": "The Sapling output index, or the Orchard action index"},
"change": { "type": "boolean", "description": "True if this output was received by a change address"}
}
},
"Balance": {
"type": "object",
"properties": {
"transparent": { "type": "integer", "description": "Confirmed transparent balance in zats." },
"sapling": { "type": "integer", "description": "Confirmed Sapling balance in zats." },
"orchard": { "type": "integer", "description": "Confirmed Orchard balance in zats." }
}
},
"Operation": {
"type": "object",
"properties": {
"uuid": {"type": "string", "description": "Operation Identifier"},
"start": {"type": "string", "description": "The date and time the operation started"},
"end": {"type": ["string", "null"], "description": "The date and time the operation ended. If the operation is still running, this field is null"},
"status": {"type": "string", "enum": ["Processing", "Failed", "Successful"], "description": "If the operation has started it will show Processing, once it completes it will show Failed or Successful depending on the outcome"},
"result": {"type": ["string", "null"], "description": "For a succesful transaction operation, the transaction ID. For failed operations, the error message. For pending operations, this field is null."}
}
},
"TxRequest": {
"type": "object",
"properties": {
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
"amount": { "type": "number", "description": "The amount to send in ZEC"},
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
}
}
},
"examples": {},
"tags": {
"draft": {"name": "Draft"},
"wip": {"name": "WIP"}
},
"errors": {
"ZebraNotAvailable": {
"code": -32000,
"message": "Zebra not available"
},
"NoWallets": {
"code": -32001,
"message": "No wallets available. Please create one first"
},
"NoAccounts": {
"code": -32002,
"message": "No accounts available. Please create one first"
},
"NoAddress": {
"code": -32003,
"message": "No addresses available for this account. Please create one first"
},
"UnknownAddress": {
"code": -32004,
"message": "Address does not belong to the wallet"
},
"InvalidAddress": {
"code": -32005,
"message": "Unable to parse address"
},
"InvalidAccount": {
"code": -32006,
"message": "Account does not exist."
},
"DuplicateName": {
"code": -32007,
"message": "Entity with that name already exists."
},
"InvalidWallet": {
"code": -32008,
"message": "Wallet does not exist."
},
"OpNotFound": {
"code": -32009,
"message": "Operation ID not found."
},
"InternalError": {
"code": -32010,
"message": "Varies"
},
"InvalidRecipient": {
"code": -32011,
"message": "The provided recipient address is not valid."
},
"ZenithBusy": {
"code": -32012,
"message": "The Zenith server is syncing, please try again later."
}
}
}
}

79
zenith.cabal
View file

@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: zenith name: zenith
version: 0.6.0.0-beta version: 0.7.0.0-beta
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Rene Vergara author: Rene Vergara
@ -35,56 +35,65 @@ library
Zenith.Utils Zenith.Utils
Zenith.Zcashd Zenith.Zcashd
Zenith.Scanner Zenith.Scanner
Zenith.RPC
Zenith.Tree
hs-source-dirs: hs-source-dirs:
src src
build-depends: build-depends:
Clipboard Clipboard
, Hclip
, JuicyPixels
, aeson , aeson
, array , array
, ascii-progress , ascii-progress
, async
, base >=4.12 && <5 , base >=4.12 && <5
, base64-bytestring , base64-bytestring
, binary
, borsh
, brick , brick
, bytestring , bytestring
, configurator
, data-default , data-default
, directory , directory
, filepath
, esqueleto , esqueleto
, resource-pool
, binary
, exceptions , exceptions
, monad-logger , filepath
, vty-crossplatform
, secp256k1-haskell >= 1
, pureMD5
, ghc , ghc
, generics-sop
, haskoin-core , haskoin-core
, hexstring , hexstring
, http-client , http-client
, http-conduit , http-conduit
, http-types , http-types
, JuicyPixels
, qrcode-core
, qrcode-juicypixels
, microlens , microlens
, microlens-mtl , microlens-mtl
, microlens-th , microlens-th
, monad-logger
, transformers
, monomer , monomer
, mtl , mtl
, persistent , persistent
, Hclip
, persistent-sqlite , persistent-sqlite
, persistent-template , persistent-template
, process , process
, pureMD5
, qrcode-core
, qrcode-juicypixels
, regex-base , regex-base
, regex-compat , regex-compat
, regex-posix , regex-posix
, resource-pool
, scientific , scientific
, secp256k1-haskell >= 1
, servant-server
, text , text
, text-show , text-show
, time , time
, uuid
, vector , vector
, vty , vty
, vty-crossplatform
, word-wrap , word-wrap
, zcash-haskell , zcash-haskell
--pkgconfig-depends: rustzcash_wrapper --pkgconfig-depends: rustzcash_wrapper
@ -110,15 +119,21 @@ executable zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010
executable zenscan executable zenithserver
ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
main-is: ZenScan.hs main-is: Server.hs
hs-source-dirs: hs-source-dirs:
app app
build-depends: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, configurator , configurator
, monad-logger , monad-logger
, wai-extra
, warp
, servant-server
, text
, unix
, zcash-haskell
, zenith , zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010
@ -132,8 +147,11 @@ test-suite zenith-tests
build-depends: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, aeson
, configurator , configurator
, monad-logger , monad-logger
, borsh
, aeson
, data-default , data-default
, sort , sort
, text , text
@ -148,3 +166,34 @@ test-suite zenith-tests
, zenith , zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010
test-suite zenithserver-tests
type: exitcode-stdio-1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N
main-is: ServerSpec.hs
hs-source-dirs:
test
build-depends:
base >=4.12 && <5
, bytestring
, aeson
, configurator
, monad-logger
, data-default
, sort
, text
, time
, uuid
, http-conduit
, persistent
, persistent-sqlite
, hspec
, hexstring
, warp
, servant-server
, HUnit
, directory
, zcash-haskell
, zenith
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010