Compare commits

...

81 commits

Author SHA1 Message Date
f5f1eddc59 zrpc-docker - Zenith RPC server
- Docker Image distribution bundle generation
2024-09-18 12:19:08 -04:00
7189ddcb2a
feat: update to use new createTransaction 2024-09-17 14:23:35 -05:00
4a874897cf
feat: draft new prepareTxV2 function 2024-09-16 11:52:57 -05:00
befc3e46cc
feat: add PrivacyPolicy type 2024-09-14 15:30:02 -05:00
eaa596fdac
docs: fix spec error 2024-09-14 09:10:01 -05:00
a2be940648
docs: correct sendmany parameters 2024-09-14 08:59:31 -05:00
f4f149d6a2
docs: fix typo in sendmany spec 2024-09-14 08:56:15 -05:00
4aad9cb57f
docs: update the sendmany spec 2024-09-14 08:54:12 -05:00
c9a42572d3
docs: correct sendmany schemas in OpenRPC 2024-09-14 06:54:00 -05:00
932d79ad57
docs: add examples for sendmany OpenRPC 2024-09-14 06:47:18 -05:00
a2743842dd
docs: update OpenRPC spec for sendmany 2024-09-13 17:20:31 -05:00
e46cd01f41
Add address book 2024-09-13 07:09:31 -05:00
322f2b8959
Merge branch 'milestone3' into rav001 2024-09-13 07:08:58 -05:00
bf4118b09d
Merge pull request 'Add base addressbook to GUI' (#102) from rvv041 into milestone3
Reviewed-on: https://git.vergara.tech///Vergara_Tech/zenith/pulls/102
2024-09-13 11:39:57 +00:00
59d3ee4d37
Merge branch 'milestone3' into rvv041 2024-09-13 06:37:11 -05:00
a3a8bb1eaa rvv041 - AddressBook - empty Address book database case 2024-09-11 21:34:15 -04:00
06b2cd9222 rvv041 - Address Book - Edit Address Book Description working
- Delete Address Book Entry working
2024-09-08 17:21:17 -04:00
185738eccc rvv041 - Address Book - Edit Address Book entry description in progress
- "Delete entry" button added (functionality not implemented yet)
2024-09-07 17:09:33 -04:00
87feab284e rvv041 - Address Book - Copy ZEC Address to clipboard implemented
- Edit Adress Book entry in progress.
2024-09-06 19:50:50 -04:00
5ce0b5fa0f rvv0041 - Address Book - Show Address Book entry on mouse click completed 2024-09-06 17:16:22 -04:00
538216944d
feat: Update addressbook list after save 2024-09-06 08:42:17 -05:00
dee0a7e8e8 rvv041 - Address Book - New entry form working correctly
- Show entry zec address on row click
2024-09-05 22:19:41 -04:00
b3df16f217 rvv041 - Address Book - Entry form working partially 2024-09-05 13:50:52 -04:00
0142ea90ae rvv041 - Address Book - in progress.... 2024-09-05 11:31:51 -04:00
1931098ee9 rvv041 - AddressBook - reloading AddressBook List in progress... 2024-09-05 10:13:32 -04:00
35dce186fd
feat: getoperationstatus RPC method 2024-09-04 13:10:09 -05:00
bd3d9e8067
docs: fixed typo in OpenRPC 2024-09-04 11:11:01 -05:00
f780e996e0
docs: info for getoperationstatus 2024-09-04 11:08:00 -05:00
dcdf2e8304
Update to OpenRPC spec 2024-09-04 09:17:12 -05:00
f8fa5a005a rvv041 - AddressBook - Save new address book entry problem 2024-09-02 09:40:57 -04:00
70123a7261
Add examples to OpenRPC spec 2024-08-30 15:25:25 -05:00
1caa4efdb4
Implement getnewaddress RPC method 2024-08-30 15:14:48 -05:00
73ad2f0eb3 rvv041 - AddressBook - Record ID added to address book entries. 2024-08-29 14:42:58 -04:00
6503af6a98
Update spec for getnewaddress 2024-08-29 09:19:10 -05:00
67d334a60b rvv041 - AddressBook main window - address description list ready
New Address Entry form - Description and Address fields ready
2024-08-28 21:21:05 -04:00
fae0def6a8
Implement getnewaccount 2024-08-26 15:25:31 -05:00
35ab075703
Update getnewaccount on RPC 2024-08-26 13:49:00 -05:00
0b7bf1db99
Draft getnewaccount RPC 2024-08-24 08:59:26 -05:00
40fb9228a2
Add example to OpenRPC 2024-08-24 07:51:07 -05:00
4ee09238d8
Implement getnewwallet RPC method 2024-08-24 07:45:42 -05:00
6875917ec7
Fix button style 2024-08-20 16:46:01 -05:00
cdd28d2184 rvv041 - New AddressBook entry form - Check for valid address added. 2024-08-19 18:12:57 -04:00
934bff1454
Implement getbalance 2024-08-16 13:31:25 -05:00
9c7e808794
Add example for getbalance 2024-08-16 13:28:44 -05:00
9917356b40
Add result to OpenRPC 2024-08-15 14:41:10 -05:00
e1dfb66fae
Start work on getbalance 2024-08-15 11:46:05 -05:00
a3df217992
Remove tags for listreceived in OpenRPC 2024-08-15 11:41:03 -05:00
e94ca5e8c4
Add example to OpenRPC 2024-08-15 11:38:57 -05:00
66767da36a
Implement listreceived 2024-08-15 11:17:24 -05:00
b75ed16a3e
Implement note search by address ID 2024-08-12 15:35:00 -05:00
14cf97d473
Add schema change detection 2024-08-10 08:17:35 -05:00
c68c504b53
Refactor for new schema for ZcashTransaction 2024-08-10 07:52:45 -05:00
46b4969da5
Implement database migration 2024-08-10 07:04:40 -05:00
c9dea01644
Fix typos in OpenRPC 2024-08-08 10:11:10 -05:00
d4fd7c5044
Add placeholders for OpenRPC 2024-08-08 09:31:34 -05:00
473192e34b
Create type for Zcash note 2024-08-08 09:24:44 -05:00
d1789b634e
Fix typo in OpenRPC 2024-08-08 09:22:37 -05:00
2dfb11dc0f
Start work on listreceived 2024-08-08 09:20:35 -05:00
9cbeb5fbb0
Add getoperationstatus to OpenRPC spec 2024-08-07 12:10:44 -05:00
2cfaf5959d
Add placeholders to OpenRPC spec 2024-08-07 11:57:10 -05:00
b8980bd219
Implement listaddresses 2024-08-07 11:28:40 -05:00
339c93905f
Use TemplateHaskell for JSON instances 2024-08-06 16:08:51 -05:00
675ca9d5e3
Add draft of listaddresses 2024-08-06 16:08:26 -05:00
4553f964f3
Implement listaccounts 2024-08-06 13:38:00 -05:00
dbe352acac
Add method descriptions to RPC 2024-08-05 15:44:11 -05:00
606c25c2c3
Update RPC docs 2024-08-05 15:16:03 -05:00
a0b92ba468
Add example to OpenRPC for listwallets 2024-08-05 13:04:57 -05:00
f7efa85cdd
Implement listwallets 2024-08-05 12:54:02 -05:00
0d5ff79b96
Add Zenith server executable 2024-08-03 07:01:11 -05:00
abf02cf90d
Add OpenRPC spec 2024-08-03 07:00:12 -05:00
e3de5c7624 rvv041 - AddressBook GUI - version with display order problem 2024-07-31 17:23:49 -04:00
8ba1dfa7c7
Make RPC port configurable 2024-07-24 16:13:13 -05:00
cbcf7c9c8c
Implement basic auth on server 2024-07-24 16:03:49 -05:00
b66d0d9563
Add fields to config 2024-07-24 16:03:23 -05:00
a60534a5c2
Merge branch 'milestone3' into rav001 2024-07-23 13:59:49 -05:00
94bfca95ca
Start RPC server 2024-07-23 13:47:07 -05:00
662f9cd5ed rvv041 - Added "gui" option to usage message 2024-07-22 21:48:36 -04:00
d37269bf44 rvv041 - Zenith Utils -> GetZenithPaht added 2024-07-22 20:58:46 -04:00
c89d5a46d4 rvv041 - Zenith dbFilePath changed for dbFileName 2024-07-22 20:50:49 -04:00
01459544a5 rvv041 - Merge with Milestone2 2024-07-22 18:29:58 -04:00
3a5e593a65
Merge branch 'milestone2' into rav001 2024-07-16 09:11:48 -05:00
36 changed files with 4351 additions and 485 deletions

2
.gitignore vendored
View file

@ -5,3 +5,5 @@ zenith.db
zenith.log zenith.log
zenith.db-shm zenith.db-shm
zenith.db-wal zenith.db-wal
docker_files/zenithrpc-docker_0.7.0.0.7z
docker_files/zenithrpc-docker_0.7.0.0/

View file

@ -5,6 +5,26 @@ 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).
## [Unreleased]
### 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
### Changed
- Detection of changes in database schema for automatic re-scan
## [0.6.0.0-beta] ## [0.6.0.0-beta]
### Added ### Added

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,7 @@ main = do
of of
"gui" -> runZenithGUI myConfig "gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig "tui" -> runZenithTUI myConfig
"rescan" -> clearSync myConfig "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
_ -> printUsage _ -> printUsage
else printUsage else printUsage
@ -236,4 +239,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)"

54
app/Server.hs Normal file
View file

@ -0,0 +1,54 @@
{-# LANGUAGE OverloadedStrings #-}
module Server where
import Control.Exception (throwIO, try)
import Control.Monad (when)
import Data.Configurator
import Network.Wai.Handler.Warp (run)
import Servant
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (initDb)
import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
import Zenith.Scanner (rescanZebra)
import Zenith.Types (Config(..))
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"
let myConfig = Config dbFileName 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 dbFileName
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zebraHost zebraPort dbFileName
let myState =
State
(zgb_net chainInfo)
zebraHost
zebraPort
dbFileName
(zgi_build zebra)
(zgb_blocks chainInfo)
run nodePort $
serveWithContext
(Proxy :: Proxy ZenithRPC)
ctx
(zenithServer myState)

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

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,

48
docker_files/Dockerfile Normal file
View file

@ -0,0 +1,48 @@
# =====================================================
# Zenith RPC Server Image
# =====================================================
FROM ubuntu:22.04
RUN apt update
# Set environment variables to non-interactive mode for installation
ENV DEBIAN_FRONTEND=noninteractive
# Update the package list and install necessary packages
RUN apt-get install -y \
libsecp256k1-dev \
libglew-dev \
libsdl2-dev
RUN apt-get clean \
&& rm -rf /var/lib/apt/lists/*
# Create a new user (e.g., "zenusr") and set a password
RUN useradd -ms /bin/bash zenusr
RUN echo "1234\n1234\n" | passwd zenusr
RUN mkdir /home/zenusr/Zenith
RUN chown zenusr:zenusr -R /home/zenusr/Zenith
COPY scripts/bash_rc_adm /root/.bashrc
COPY scripts/bash_rc_usr /home/zenusr/.bashrc
COPY scripts/welcome.sh /etc/profile.d/welcome.sh
RUN chmod +x /etc/profile.d/welcome.sh
COPY bin/zenithserver /usr/local/bin
COPY bin/startrpc /usr/local/bin
COPY lib/librustzcash_wrapper.so /usr/local/lib
COPY Downloads/libc-bin_2.38-1ubuntu6_amd64.deb /home/zenusr/Downloads/
COPY Downloads/libc-dev-bin_2.38-1ubuntu6_amd64.deb /home/zenusr/Downloads/
COPY Downloads/libc6_2.38-1ubuntu6_amd64.deb /home/zenusr/Downloads/
RUN echo '#!/bin/bash\ncd /home/zenusr/Downloads\ndpkg -i libc6_2.38-1ubuntu6_amd64.deb libc-bin_2.38-1ubuntu6_amd64.deb libc-dev-bin_2.38-1ubuntu6_amd64.deb' > /usr/local/bin/updlibc
RUN chmod +x /usr/local/bin/updlibc
RUN updlibc
# Set the user to "zenusr"
USER zenusr
WORKDIR /home/zenusr
ENV USER=zenusr
CMD ["startrpc"]

Binary file not shown.

6
docker_files/bin/startrpc Executable file
View file

@ -0,0 +1,6 @@
#!/bin/bash
if [ x"${EXPERT_MODE}" == "x" ]; then
zenithserver
else
/bin/bash -l
fi

BIN
docker_files/bin/zenithserver Executable file

Binary file not shown.

43
docker_files/cfg/runzenithrpc Executable file
View file

@ -0,0 +1,43 @@
#!/bin/bash
ZFOLDER=~/Zenith
IMAGE_NAME=zenithrpc-docker:0.7.0.0
for i in "$@"
do case $i in
-e=*|--expert=*)
EXPERTMODE="1"
;;
*)
EXPERTMODE="0"
;;
esac
done
# Check if docker engine is running
if ! systemctl is-active --quiet docker ; then
echo "Docker is not active/installed, "
echo "Please activate docker before proceeding!!."
echo "Aborting process..."
exit
fi
# Check if data folder exists
if [ ! -d "$ZFOLDER" ]; then
echo "Error starting Zenith RPC server image"
echo "Zenith configurtion and data folder ($ZFOLDER) does not exists."
echo "Aborting process..."
exit
fi
# Check if the image exists locally
if [[ "$(docker images -q $IMAGE_NAME 2> /dev/null)" == "" ]]; then
echo "Error starting Zenith RPC server image"
echo "Image $IMAGE_NAME not found locally."
echo "Aborting process..."
exit
fi
# Start image in detached mode
docker run --rm -d --mount src=$ZFOLDER,target=/home/zenusr/Zenith,type=bind --net=host --env EXPERT_MODE=$EXPERTMODE $IMAGE_NAME
# End

View file

@ -0,0 +1,5 @@
nodeUser = "user"
nodePwd = "superSecret"
dbFileName = "zenith.db"
zebraHost = "127.0.0.1"
zebraPort = 18232

59
docker_files/dockerpkg Executable file
View file

@ -0,0 +1,59 @@
#!/bin/bash
ZVERSION="0.7.0.0"
echo "Docker image package generator"
echo
if ! systemctl is-active --quiet docker ; then
echo "Docker is not active/installed, "
echo "Please activate docker before proceeding!!."
echo
exit
fi
echo "Updating docker binary files ...."
echo
echo "... copying zenith server to ./bin folder"
cp "../dist-newstyle/build/x86_64-linux/ghc-9.6.5/zenith-"$ZVERSION"/build/zenithserver/zenithserver" "bin/"
echo "... copying librustzcash_wrapper.so to ./lib folder"
cp "../zcash-haskell/librustzcash-wrapper/target/x86_64-unknown-linux-gnu/debug/librustzcash_wrapper.so" "lib/"
echo
read -r -p "Do you want to create the docker image? [Y/n] " response
case "$response" in
[yY])
if docker image ls | grep -q "zenithrpc-docker" ; then
echo "... removing previous docker image"
docker rmi -f "zenithrpc-docker:"$ZVERSION
fi
echo "... creating zenithrpc-docker:"$ZVERSION" image"
docker build -t "zenithrpc-docker:"$ZVERSION .
echo "... docker image zenithrpc-docker:"$ZVERSION" created."
echo "... exporting zenithrpc-docker:"$ZVERSION" as .tar file"
docker save -o zenithrpc-docker_$ZVERSION.tar zenithrpc-docker:$ZVERSION
echo "... zenithrpc-docker:"$ZVERSION" image ready."
echo "... creating distribution package file "
if [ -d zenithrpc-docker_$ZVERSION ]; then
rm -rf zenithrpc-docker_$ZVERSION
fi
echo "... creating distribution folder "
mkdir zenithrpc-docker_$ZVERSION
echo "... copying setup_docker script"
chmod +x setup_docker
cp setup_docker zenithrpc-docker_$ZVERSION/
chmod -x setup_docker
echo "... copying cfg folder"
cp -r cfg zenithrpc-docker_$ZVERSION/
echo "... moving docker image to distribution folder"
mv zenithrpc-docker_$ZVERSION.tar zenithrpc-docker_$ZVERSION/
if [ -f zenithrpc-docker_$ZVERSION.7z ]; then
rm zenithrpc-docker_$ZVERSION.7z
fi
echo "... creating distribution package zenithrpc-docker_$ZVERSION.7z "
7z a zenithrpc-docker_$ZVERSION.7z zenithrpc-docker_$ZVERSION
echo "... distribution file created. (zenithrpc-docker_$ZVERSION.tar.gz)"
;;
*)
echo "... docker image not created."
;;
esac
echo
echo "Done "
echo

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -0,0 +1,100 @@
# ~/.bashrc: executed by bash(1) for non-login shells.
# see /usr/share/doc/bash/examples/startup-files (in the package bash-doc)
# for examples
# If not running interactively, don't do anything
[ -z "$PS1" ] && return
# don't put duplicate lines in the history. See bash(1) for more options
# ... or force ignoredups and ignorespace
HISTCONTROL=ignoredups:ignorespace
# append to the history file, don't overwrite it
shopt -s histappend
# for setting history length see HISTSIZE and HISTFILESIZE in bash(1)
HISTSIZE=1000
HISTFILESIZE=2000
# check the window size after each command and, if necessary,
# update the values of LINES and COLUMNS.
shopt -s checkwinsize
# make less more friendly for non-text input files, see lesspipe(1)
[ -x /usr/bin/lesspipe ] && eval "$(SHELL=/bin/sh lesspipe)"
# set variable identifying the chroot you work in (used in the prompt below)
if [ -z "$debian_chroot" ] && [ -r /etc/debian_chroot ]; then
debian_chroot=$(cat /etc/debian_chroot)
fi
# set a fancy prompt (non-color, unless we know we "want" color)
case "$TERM" in
xterm-color) color_prompt=yes;;
esac
# uncomment for a colored prompt, if the terminal has the capability; turned
# off by default to not distract the user: the focus in a terminal window
# should be on the output of commands, not on the prompt
#force_color_prompt=yes
if [ -n "$force_color_prompt" ]; then
if [ -x /usr/bin/tput ] && tput setaf 1 >&/dev/null; then
# We have color support; assume it's compliant with Ecma-48
# (ISO/IEC-6429). (Lack of such support is extremely rare, and such
# a case would tend to support setf rather than setaf.)
color_prompt=yes
else
color_prompt=
fi
fi
if [ "$color_prompt" = yes ]; then
PS1='${debian_chroot:+($debian_chroot)}\[\033[01;32m\]\u@\h\[\033[00m\]:\[\033[01;34m\]\w\[\033[00m\]\$ '
else
PS1='${debian_chroot:+($debian_chroot)}\u@\h:\w\$ '
fi
unset color_prompt force_color_prompt
# If this is an xterm set the title to user@host:dir
case "$TERM" in
xterm*|rxvt*)
PS1="\[\e]0;${debian_chroot:+($debian_chroot)}\u@\h: \w\a\]$PS1"
;;
*)
;;
esac
# enable color support of ls and also add handy aliases
if [ -x /usr/bin/dircolors ]; then
test -r ~/.dircolors && eval "$(dircolors -b ~/.dircolors)" || eval "$(dircolors -b)"
alias ls='ls --color=auto'
#alias dir='dir --color=auto'
#alias vdir='vdir --color=auto'
alias grep='grep --color=auto'
alias fgrep='fgrep --color=auto'
alias egrep='egrep --color=auto'
fi
# some more ls aliases
alias ll='ls -alF'
alias la='ls -A'
alias l='ls -CF'
# Alias definitions.
# You may want to put all your additions into a separate file like
# ~/.bash_aliases, instead of adding them here directly.
# See /usr/share/doc/bash-doc/examples in the bash-doc package.
if [ -f ~/.bash_aliases ]; then
. ~/.bash_aliases
fi
# enable programmable completion features (you don't need to enable
# this, if it's already enabled in /etc/bash.bashrc and /etc/profile
# sources /etc/bash.bashrc).
#if [ -f /etc/bash_completion ] && ! shopt -oq posix; then
# . /etc/bash_completion
#fi
export LD_LIBRARY_PATH=/usr/local/lib

View file

@ -0,0 +1,118 @@
# ~/.bashrc: executed by bash(1) for non-login shells.
# see /usr/share/doc/bash/examples/startup-files (in the package bash-doc)
# for examples
# If not running interactively, don't do anything
case $- in
*i*) ;;
*) return;;
esac
# don't put duplicate lines or lines starting with space in the history.
# See bash(1) for more options
HISTCONTROL=ignoreboth
# append to the history file, don't overwrite it
shopt -s histappend
# for setting history length see HISTSIZE and HISTFILESIZE in bash(1)
HISTSIZE=1000
HISTFILESIZE=2000
# check the window size after each command and, if necessary,
# update the values of LINES and COLUMNS.
shopt -s checkwinsize
# If set, the pattern "**" used in a pathname expansion context will
# match all files and zero or more directories and subdirectories.
#shopt -s globstar
# make less more friendly for non-text input files, see lesspipe(1)
[ -x /usr/bin/lesspipe ] && eval "$(SHELL=/bin/sh lesspipe)"
# set variable identifying the chroot you work in (used in the prompt below)
if [ -z "${debian_chroot:-}" ] && [ -r /etc/debian_chroot ]; then
debian_chroot=$(cat /etc/debian_chroot)
fi
# set a fancy prompt (non-color, unless we know we "want" color)
case "$TERM" in
xterm-color|*-256color) color_prompt=yes;;
esac
# uncomment for a colored prompt, if the terminal has the capability; turned
# off by default to not distract the user: the focus in a terminal window
# should be on the output of commands, not on the prompt
#force_color_prompt=yes
if [ -n "$force_color_prompt" ]; then
if [ -x /usr/bin/tput ] && tput setaf 1 >&/dev/null; then
# We have color support; assume it's compliant with Ecma-48
# (ISO/IEC-6429). (Lack of such support is extremely rare, and such
# a case would tend to support setf rather than setaf.)
color_prompt=yes
else
color_prompt=
fi
fi
if [ "$color_prompt" = yes ]; then
PS1='${debian_chroot:+($debian_chroot)}\[\033[01;32m\]\u@\h\[\033[00m\]:\[\033[01;34m\]\w\[\033[00m\]\$ '
else
PS1='${debian_chroot:+($debian_chroot)}\u@\h:\w\$ '
fi
unset color_prompt force_color_prompt
# If this is an xterm set the title to user@host:dir
case "$TERM" in
xterm*|rxvt*)
PS1="\[\e]0;${debian_chroot:+($debian_chroot)}\u@\h: \w\a\]$PS1"
;;
*)
;;
esac
# enable color support of ls and also add handy aliases
if [ -x /usr/bin/dircolors ]; then
test -r ~/.dircolors && eval "$(dircolors -b ~/.dircolors)" || eval "$(dircolors -b)"
alias ls='ls --color=auto'
#alias dir='dir --color=auto'
#alias vdir='vdir --color=auto'
alias grep='grep --color=auto'
alias fgrep='fgrep --color=auto'
alias egrep='egrep --color=auto'
fi
# colored GCC warnings and errors
#export GCC_COLORS='error=01;31:warning=01;35:note=01;36:caret=01;32:locus=01:quote=01'
# some more ls aliases
alias ll='ls -alF'
alias la='ls -A'
alias l='ls -CF'
# Add an "alert" alias for long running commands. Use like so:
# sleep 10; alert
alias alert='notify-send --urgency=low -i "$([ $? = 0 ] && echo terminal || echo error)" "$(history|tail -n1|sed -e '\''s/^\s*[0-9]\+\s*//;s/[;&|]\s*alert$//'\'')"'
# Alias definitions.
# You may want to put all your additions into a separate file like
# ~/.bash_aliases, instead of adding them here directly.
# See /usr/share/doc/bash-doc/examples in the bash-doc package.
if [ -f ~/.bash_aliases ]; then
. ~/.bash_aliases
fi
# enable programmable completion features (you don't need to enable
# this, if it's already enabled in /etc/bash.bashrc and /etc/profile
# sources /etc/bash.bashrc).
if ! shopt -oq posix; then
if [ -f /usr/share/bash-completion/bash_completion ]; then
. /usr/share/bash-completion/bash_completion
elif [ -f /etc/bash_completion ]; then
. /etc/bash_completion
fi
fi
export LD_LIBRARY_PATH=/usr/local/lib

View file

@ -0,0 +1,8 @@
#!/bin/bash
echo
echo "============================================="
echo "Welcome to Zenith RPC seerver enviroment"
echo "v0.7.0.0"
echo "Vergara Technologies LLC"
echo "============================================="
echo

70
docker_files/setup_docker Normal file
View file

@ -0,0 +1,70 @@
#!/bin/bash
ZVERSION="0.7.0.0"
echo
echo "Zenith RPC Server Image Setup"
echo
echo "... testing if docker service is active.."
if systemctl is-active --quiet docker; then
echo "... Docker service active"
echo
if [ -d $HOME"/Zenith" ]; then
echo "Warning: Zenith Server configuration already exist, this procedure will create"
echo " a new configuration file. Your previous configurarion "
echo " will be saved as 'previous-zenith.cfg'. (a Backup is recommended)."
echo
read -r -p "Do you want to proceed ? [Y/n] " response
case "$response" in
[yY])
if [ -f $HOME/Zenith/previous-zenith.cfg ]; then
rm $HOME/Zenith/previous-zenith.cfg
fi
mv $HOME/Zenith/zenith.cfg $HOME/Zenith/previous-zenith.cfg
;;
*)
echo "... Zenith docker image setup not completed."
exit
;;
esac
else
echo
echo "... creating Zenith folder"
mkdir -p $HOME/Zenith/assets
fi
if docker image ls | grep -q "zenithrpc-docker" ; then
echo "... removing previous docker image"
docker rmi -f "zenithrpc-docker:"$ZVERSION
fi
echo "... loading zenithrpc-docker:"$ZVERSION" image"
docker load < zenithrpc-docker_$ZVERSION.tar
echo "... docker image zenithrpc-docker:"$ZVERSION" loaded."
echo "... creating default configuration"
cp cfg/zenith.cfg $HOME/Zenith/
echo "... copying zenith assets to Zenith folder."
cp -r cfg/assets $HOME/Zenith/assets
if ! [ -d $HOME/.local/bin ]; then
echo "... creating $HOME/.local/bin folder"
mkdir -p $HOME/.local/bin
else
echo "... $HOME/.local/bin exists"
fi
if [ -f $HOME/.local/bin/runzenithrpc ]; then
rm $HOME/.local/bin/runzenithrpc
fi
echo "... copying runzenithrpc to $HOME/.local/bin"
cp cfg/runzenithrpc $HOME/.local/bin/
if ! echo $PATH | grep -q $HOME/.local/bin ; then
echo PATH=$PATH:$HOME/.local/bin | tee -a $HOME/.bashrc
echo "... reloading configuration ...."
source $HOME/.bashrc
else
echo "... PATH=$PATH"
fi
echo
echo "To start Zenith RPC server execute 'runzenithrpc' from the command line."
else
echo "... Docker service is not active"
echo "... Please activate Docker service first."
fi
echo
echo "Done"
echo

View file

@ -10,10 +10,8 @@ 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
@ -42,7 +40,6 @@ import Brick.Widgets.Core
, joinBorders , joinBorders
, padAll , padAll
, padBottom , padBottom
, padLeft
, padTop , padTop
, setAvailableSize , setAvailableSize
, str , str
@ -63,10 +60,10 @@ 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 (forever, 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 (runFileLoggingT, runNoLoggingT)
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
@ -83,19 +80,15 @@ 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 (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types 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 (processTx, rescanZebra, updateConfs)
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, PhraseDB(..) , PhraseDB(..)
@ -722,12 +715,12 @@ 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 -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
_ <- liftIO $ initDb dbP scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP pool <- runNoLoggingT $ initPool dbP
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- getMaxBlock pool $ ZcashNetDB znet
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of case confUp of
Left _e0 -> Left _e0 ->
@ -772,7 +765,7 @@ scanZebra dbP zHost zPort b eChan = do
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Left e2 -> 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) $ mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ BC.writeBChan eChan $ TickVal step liftIO $ BC.writeBChan eChan $ TickVal step
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
@ -827,7 +820,13 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
syncWallet syncWallet
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort)) (Config
(s ^. dbPath)
(s ^. zebraHost)
(s ^. zebraPort)
"user"
"pwd"
8080)
selWallet selWallet
BT.modify $ set displayBox BlankDisplay BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0 BT.modify $ set barValue 0.0
@ -862,6 +861,7 @@ appEvent (BT.AppEvent t) = do
(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
@ -1363,15 +1363,21 @@ 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
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)
@ -1407,7 +1413,8 @@ runZenithTUI config = do
(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
@ -1431,7 +1438,7 @@ runZenithTUI config = do
"" ""
Nothing Nothing
uBal uBal
Left e -> do Left _e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
show port <> ". Check your configuration." show port <> ". Check your configuration."

View file

@ -4,7 +4,7 @@
module Zenith.Core where module Zenith.Core where
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (forM, when) import Control.Monad (forM, unless, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
@ -73,6 +73,7 @@ import Zenith.Types
, HexStringDB(..) , HexStringDB(..)
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..)
, RseedDB(..) , RseedDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
@ -223,6 +224,47 @@ createWalletAddress n i zNet scope za = do
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec)) encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
(ScopeDB scope) (ScopeDB scope)
-- | Create an external unified address for the given account and index with custom receivers
createCustomWalletAddress ::
T.Text -- ^ The address nickname
-> Int -- ^ The address' index
-> ZcashNet -- ^ The network for this address
-> Scope -- ^ External or Internal
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
-> Bool -- ^ Exclude Sapling
-> Bool -- ^ Exclude Transparent
-> IO WalletAddress
createCustomWalletAddress n i zNet scope za exSap exTr = do
let oRec =
genOrchardReceiver i scope $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
let sRec =
if exSap
then Nothing
else case scope of
External ->
genSaplingPaymentAddress i $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
Internal ->
genSaplingInternalAddress $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
tRec <-
if exTr
then return Nothing
else Just <$>
genTransparentReceiver
i
scope
(getTranSK $ zcashAccountTPrivateKey $ entityVal za)
return $
WalletAddress
i
(entityKey za)
n
(UnifiedAddressDB $
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec tRec)
(ScopeDB scope)
-- * Wallet -- * Wallet
-- | Find the Sapling notes that match the given spending key -- | Find the Sapling notes that match the given spending key
findSaplingOutputs :: findSaplingOutputs ::
@ -237,7 +279,7 @@ findSaplingOutputs config b znet za = do
let zebraPort = c_zebraPort config let zebraPort = c_zebraPort config
let zn = getNet znet let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
tList <- getShieldedOutputs pool b tList <- getShieldedOutputs pool b znet
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
decryptNotes sT zn pool tList decryptNotes sT zn pool tList
@ -328,7 +370,7 @@ findOrchardActions config b znet za = do
let zebraPort = c_zebraPort config let zebraPort = c_zebraPort config
let zn = getNet znet let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b tList <- getOrchardActions pool b znet
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees let sT = OrchardCommitmentTree $ ztiOrchard trees
decryptNotes sT zn pool tList decryptNotes sT zn pool tList
@ -495,19 +537,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
return $ Left ZHError return $ Left ZHError
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
spParams <- liftIO $ BS.readFile "sapling-spend.params"
outParams <- liftIO $ BS.readFile "sapling-output.params"
if show (md5 $ LBS.fromStrict spParams) /=
"0f44c12ef115ae019decf18ade583b20"
then logErrorN "Can't validate sapling parameters"
else logInfoN "Valid Sapling spend params"
if show (md5 $ LBS.fromStrict outParams) /=
"924daf81b87a81bbbb9c7d18562046c8"
then logErrorN "Can't validate sapling parameters"
else logInfoN "Valid Sapling output params"
--print $ BS.length spParams
--print $ BS.length outParams
logDebugN "Read Sapling params"
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats logDebugN $ T.pack $ show zats
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
@ -542,8 +571,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
sSpends sSpends
oSpends oSpends
dummy dummy
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn zn
(bh + 3) (bh + 3)
False False
@ -569,8 +596,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
sSpends sSpends
oSpends oSpends
outgoing outgoing
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn zn
(bh + 3) (bh + 3)
True True
@ -645,7 +670,237 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
flipTxId flipTxId
(fromIntegral $ walletTrNotePosition $ entityVal n)) (fromIntegral $ walletTrNotePosition $ entityVal n))
(RawTxOut (RawTxOut
(walletTrNoteValue $ entityVal n) (fromIntegral $ walletTrNoteValue $ entityVal n)
(walletTrNoteScript $ entityVal n))
prepSSpends ::
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
prepSSpends sk notes = do
forM notes $ \n -> do
return $
SaplingTxSpend
(getBytes sk)
(DecodedNote
(fromIntegral $ walletSapNoteValue $ entityVal n)
(walletSapNoteRecipient $ entityVal n)
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
(getHex $ walletSapNoteNullifier $ entityVal n)
""
(getRseed $ walletSapNoteRseed $ entityVal n))
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
prepOSpends ::
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
prepOSpends sk notes = do
forM notes $ \n -> do
return $
OrchardTxSpend
(getBytes sk)
(DecodedNote
(fromIntegral $ walletOrchNoteValue $ entityVal n)
(walletOrchNoteRecipient $ entityVal n)
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
(getHex $ walletOrchNoteNullifier $ entityVal n)
(walletOrchNoteRho $ entityVal n)
(getRseed $ walletOrchNoteRseed $ entityVal n))
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
sapAnchor notes =
if not (null notes)
then Just $
SaplingWitness $
getHex $ walletSapNoteWitness $ entityVal $ head notes
else Nothing
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
orchAnchor notes =
if not (null notes)
then Just $
OrchardWitness $
getHex $ walletOrchNoteWitness $ entityVal $ head notes
else Nothing
-- | Prepare a transaction for sending
prepareTxV2 ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> ValidAddress
-> T.Text
-> PrivacyPolicy
-> LoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
accRead <- liftIO $ getAccountById pool za
let recipient =
case va of
Unified ua ->
case o_rec ua of
Nothing ->
case s_rec ua of
Nothing ->
case t_rec ua of
Nothing -> (0, "")
Just r3 ->
case tr_type r3 of
P2PKH -> (1, toBytes $ tr_bytes r3)
P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1)
Sapling sa -> (3, getBytes $ sa_receiver sa)
Transparent ta ->
case tr_type (ta_receiver ta) of
P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
Exchange ea ->
case tr_type (ex_address ea) of
P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
logDebugN $ T.pack $ show recipient
logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> do
logErrorN "Can't find Account"
return $ Left ZHError
Just acc -> do
logDebugN $ T.pack $ show acc
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
logDebugN "selected notes"
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <-
liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
--print tSpends
sSpends <-
liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
--print sSpends
oSpends <-
liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
--print oSpends
dummy <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
logDebugN "Calculating fee"
let feeResponse =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
dummy
zn
(bh + 3)
False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
outgoing <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
logDebugN $ T.pack $ show outgoing
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
outgoing
zn
(bh + 3)
True
logDebugN $ T.pack $ show tx
return tx
where
makeOutgoing ::
Entity ZcashAccount
-> (Int, BS.ByteString)
-> Integer
-> Integer
-> IO [OutgoingNote]
makeOutgoing acc (k, recvr) zats chg = do
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
let chgRcvr =
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return
[ OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
(fromIntegral k)
(case k of
4 ->
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
3 ->
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
_ -> "")
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
getTotalAmount ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
, [Entity WalletOrchNote])
-> Integer
getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
prepTSpends ::
TransparentSpendingKey
-> [Entity WalletTrNote]
-> IO [TransparentTxSpend]
prepTSpends sk notes = do
forM notes $ \n -> do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
case tAddRead of
Nothing -> throwIO $ userError "Couldn't read t-address"
Just tAdd -> do
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
genTransparentSecretKey
(walletAddressIndex $ entityVal tAdd)
(getScope $ walletAddressScope $ entityVal tAdd)
sk
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (ESQ.Value reverseTxId) -> do
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
return $
TransparentTxSpend
xp_key
(RawOutPoint
flipTxId
(fromIntegral $ walletTrNotePosition $ entityVal n))
(RawTxOut
(fromIntegral $ walletTrNoteValue $ entityVal n)
(walletTrNoteScript $ entityVal n)) (walletTrNoteScript $ entityVal n))
prepSSpends :: prepSSpends ::
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
@ -700,19 +955,20 @@ syncWallet ::
syncWallet config w = do syncWallet config w = do
startTime <- liftIO getCurrentTime startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config let walletDb = c_dbPath config
let znet = zcashWalletNetwork $ entityVal w
pool <- runNoLoggingT $ initPool walletDb pool <- runNoLoggingT $ initPool walletDb
accs <- runNoLoggingT $ getAccounts pool $ entityKey w accs <- runNoLoggingT $ getAccounts pool $ entityKey w
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
intAddrs <- intAddrs <-
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- runNoLoggingT $ getMaxBlock pool chainTip <- getMaxBlock pool znet
let lastBlock = zcashWalletLastSync $ entityVal w let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
sapNotes <- sapNotes <-
liftIO $ liftIO $
@ -728,48 +984,3 @@ syncWallet config w = do
_ <- updateOrchardWitnesses pool _ <- updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w) _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
testSync :: Config -> IO ()
testSync config = do
let dbPath = c_dbPath config
_ <- initDb dbPath
pool <- runNoLoggingT $ initPool dbPath
w <- getWallets pool TestNet
r <- mapM (syncWallet config) w
liftIO $ print r
{-let uaRead =-}
{-isValidUnifiedAddress-}
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
{-case uaRead of-}
{-Nothing -> print "wrong address"-}
{-Just ua -> do-}
{-startTime <- getCurrentTime-}
{-print startTime-}
{-tx <--}
{-prepareTx-}
{-"zenith.db"-}
{-"127.0.0.1"-}
{-18232-}
{-TestNet-}
{-(toSqlKey 1)-}
{-2820897-}
{-0.04-}
{-ua-}
{-"sent with Zenith, test"-}
{-print tx-}
{-endTime <- getCurrentTime-}
{-print endTime-}
{-testSend :: IO ()-}
{-testSend = do-}
clearSync :: Config -> IO ()
clearSync config = do
let dbPath = c_dbPath config
pool <- runNoLoggingT $ initPool dbPath
_ <- initDb dbPath
_ <- clearWalletTransactions pool
w <- getWallets pool TestNet
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool TestNet
r <- mapM (syncWallet config) w'
liftIO $ print r

View file

@ -18,18 +18,20 @@
module Zenith.DB where module Zenith.DB where
import Control.Exception (throwIO) import Control.Exception (SomeException(..), throwIO, try)
import Control.Monad (forM_, when) import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Data.Bifunctor (bimap)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString import Data.HexString
import Data.Int
import Data.List (group, sort) import Data.List (group, sort)
import Data.Maybe (catMaybes, fromJust, isJust) import Data.Maybe (catMaybes, fromJust, isJust)
import Data.Pool (Pool) import Data.Pool (Pool)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import Data.Time.Clock (UTCTime, getCurrentTime)
import qualified Data.UUID as U
import Data.Word import Data.Word
import Database.Esqueleto.Experimental import Database.Esqueleto.Experimental
import qualified Database.Persist.Sqlite as PS import qualified Database.Persist.Sqlite as PS
@ -40,17 +42,24 @@ import Haskoin.Transaction.Common
, TxOut(..) , TxOut(..)
, txHashToHex , txHashToHex
) )
import qualified Lens.Micro as ML ((&), (.~), (^.)) import System.Directory (doesFileExist, getHomeDirectory, removeFile)
import ZcashHaskell.Orchard (isValidUnifiedAddress) import System.FilePath ((</>))
import ZcashHaskell.Orchard
( compareAddress
, getSaplingFromUA
, isValidUnifiedAddress
)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
( DecodedNote(..) ( DecodedNote(..)
, ExchangeAddress(..)
, OrchardAction(..) , OrchardAction(..)
, OrchardBundle(..) , OrchardBundle(..)
, OrchardSpendingKey(..) , OrchardReceiver(..)
, OrchardWitness(..) , OrchardWitness(..)
, SaplingAddress(..)
, SaplingBundle(..) , SaplingBundle(..)
, SaplingCommitmentTree(..) , SaplingReceiver(..)
, SaplingSpendingKey(..)
, SaplingWitness(..) , SaplingWitness(..)
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
@ -61,11 +70,11 @@ import ZcashHaskell.Types
, TransparentBundle(..) , TransparentBundle(..)
, TransparentReceiver(..) , TransparentReceiver(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ZcashNet , ValidAddress(..)
, decodeHexText , ZcashNet(..)
) )
import Zenith.Types import Zenith.Types
( Config(..) ( AccountBalance(..)
, HexStringDB(..) , HexStringDB(..)
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
@ -74,8 +83,14 @@ import Zenith.Types
, ScopeDB(..) , ScopeDB(..)
, TransparentSpendingKeyDB , TransparentSpendingKeyDB
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashPool(..) , ZcashPool(..)
, ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..)
) )
share share
@ -128,24 +143,24 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
address WalletAddressId OnDeleteCascade OnUpdateCascade address WalletAddressId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
spent Bool spent Bool
script BS.ByteString script BS.ByteString
change Bool change Bool
position Word64 position Int
UniqueTNote tx script UniqueTNote tx script
deriving Show Eq deriving Show Eq
WalletTrSpend WalletTrSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletTrNoteId OnDeleteCascade OnUpdateCascade note WalletTrNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
UniqueTrSpend tx accId UniqueTrSpend tx accId
deriving Show Eq deriving Show Eq
WalletSapNote WalletSapNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
spent Bool spent Bool
@ -161,18 +176,18 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletSapNoteId OnDeleteCascade OnUpdateCascade note WalletSapNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
UniqueSapSepnd tx accId UniqueSapSepnd tx accId
deriving Show Eq deriving Show Eq
WalletOrchNote WalletOrchNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
spent Bool spent Bool
nullifier HexStringDB nullifier HexStringDB
position Word64 position Int64
witness HexStringDB witness HexStringDB
change Bool change Bool
witPos OrchActionId OnDeleteIgnore OnUpdateIgnore witPos OrchActionId OnDeleteIgnore OnUpdateIgnore
@ -184,7 +199,7 @@ share
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletOrchNoteId OnDeleteCascade OnUpdateCascade note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Int64
UniqueOrchSpend tx accId UniqueOrchSpend tx accId
deriving Show Eq deriving Show Eq
ZcashTransaction ZcashTransaction
@ -192,11 +207,12 @@ share
txId HexStringDB txId HexStringDB
conf Int conf Int
time Int time Int
UniqueTx block txId network ZcashNetDB
UniqueTx block txId network
deriving Show Eq deriving Show Eq
TransparentNote TransparentNote
tx ZcashTransactionId tx ZcashTransactionId
value Word64 value Int64
script BS.ByteString script BS.ByteString
position Int position Int
UniqueTNPos tx position UniqueTNPos tx position
@ -260,15 +276,173 @@ share
abaddress T.Text abaddress T.Text
UniqueABA abaddress UniqueABA abaddress
deriving Show Eq deriving Show Eq
Operation json
uuid ZenithUuid
start UTCTime
end UTCTime Maybe
status ZenithStatus
result T.Text Maybe
UniqueOp uuid
deriving Show Eq
|] |]
-- ** Type conversions
-- | @ZcashWallet@
toZcashWalletAPI :: Entity ZcashWallet -> ZcashWalletAPI
toZcashWalletAPI w =
ZcashWalletAPI
(fromIntegral $ fromSqlKey $ entityKey w)
(zcashWalletName $ entityVal w)
(getNet $ zcashWalletNetwork $ entityVal w)
(zcashWalletBirthdayHeight $ entityVal w)
(zcashWalletLastSync $ entityVal w)
-- | @ZcashAccount@
toZcashAccountAPI :: Entity ZcashAccount -> ZcashAccountAPI
toZcashAccountAPI a =
ZcashAccountAPI
(fromIntegral $ fromSqlKey $ entityKey a)
(fromIntegral $ fromSqlKey $ zcashAccountWalletId $ entityVal a)
(zcashAccountName $ entityVal a)
-- | @WalletAddress@
toZcashAddressAPI :: Entity WalletAddress -> ZcashAddressAPI
toZcashAddressAPI a =
ZcashAddressAPI
(fromIntegral $ fromSqlKey $ entityKey a)
(fromIntegral $ fromSqlKey $ walletAddressAccId $ entityVal a)
(walletAddressName $ entityVal a)
(getUA $ walletAddressUAddress $ entityVal a)
(getSaplingFromUA $
TE.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a)
(case t_rec =<<
(isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a) of
Nothing -> Nothing
Just tRec ->
Just $
encodeTransparentReceiver
(maybe
TestNet
ua_net
((isValidUnifiedAddress .
TE.encodeUtf8 . getUA . walletAddressUAddress) $
entityVal a))
tRec)
-- | @WalletTrNote@
trToZcashNoteAPI :: ConnectionPool -> Entity WalletTrNote -> IO ZcashNoteAPI
trToZcashNoteAPI pool n = do
t <- getWalletTransaction pool $ walletTrNoteTx $ entityVal n
case t of
Nothing -> throwIO $ userError "Unable to find transaction"
Just t' -> do
return $
ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Zenith.Types.Transparent -- pool
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
(walletTrNoteValue $ entityVal n) -- zats
"" -- memo
(walletTransactionConf (entityVal t') >= 10) -- confirmed
(walletTransactionBlock $ entityVal t') -- blockheight
(walletTransactionTime $ entityVal t') -- blocktime
(walletTrNotePosition $ entityVal n) -- outindex
(walletTrNoteChange $ entityVal n) -- change
-- | @WalletSapNote@
sapToZcashNoteAPI :: ConnectionPool -> Entity WalletSapNote -> IO ZcashNoteAPI
sapToZcashNoteAPI pool n = do
t <- getWalletTransaction pool $ walletSapNoteTx $ entityVal n
oi <- getSaplingOutIndex pool $ walletSapNoteWitPos $ entityVal n
case t of
Nothing -> throwIO $ userError "Unable to find transaction"
Just t' -> do
return $
ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Zenith.Types.Sapling -- pool
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
(walletSapNoteValue $ entityVal n) -- zats
(walletSapNoteMemo $ entityVal n) -- memo
(walletTransactionConf (entityVal t') >= 10) -- confirmed
(walletTransactionBlock $ entityVal t') -- blockheight
(walletTransactionTime $ entityVal t') -- blocktime
oi -- outindex
(walletSapNoteChange $ entityVal n) -- change
-- | @WalletOrchNote@
orchToZcashNoteAPI :: ConnectionPool -> Entity WalletOrchNote -> IO ZcashNoteAPI
orchToZcashNoteAPI pool n = do
t <- getWalletTransaction pool $ walletOrchNoteTx $ entityVal n
oi <- getOrchardOutIndex pool $ walletOrchNoteWitPos $ entityVal n
case t of
Nothing -> throwIO $ userError "Unable to find transaction"
Just t' -> do
return $
ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Orchard
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
(walletOrchNoteValue $ entityVal n) -- zats
(walletOrchNoteMemo $ entityVal n) -- memo
(walletTransactionConf (entityVal t') >= 10) -- confirmed
(walletTransactionBlock $ entityVal t') -- blockheight
(walletTransactionTime $ entityVal t') -- blocktime
oi -- outindex
(walletOrchNoteChange $ entityVal n) -- change
-- * Database functions -- * Database functions
-- | Initializes the database -- | Initializes the database
initDb :: initDb ::
T.Text -- ^ The database path to check T.Text -- ^ The database path to check
-> IO () -> IO (Either String Bool)
initDb dbName = do initDb dbName = do
PS.runSqlite dbName $ do runMigration migrateAll j <-
try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
(Either SomeException [T.Text])
case j of
Left _e1 -> do
pool <- runNoLoggingT $ initPool dbName
wallets <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do select . from $ table @ZcashWallet
accounts <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do select . from $ table @ZcashAccount
abook <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do select . from $ table @AddressBook
hDir <- getHomeDirectory
let backupDb = hDir </> "Zenith/.backup.db"
checkDbFile <- doesFileExist backupDb
when checkDbFile $ removeFile backupDb
_ <- PS.runSqlite (T.pack backupDb) $ runMigrationQuiet migrateAll
backupPool <- runNoLoggingT $ initPool $ T.pack backupDb
_ <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> wallets
_ <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> accounts
_ <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> abook
clearWalletTransactions pool
clearWalletData pool
m <-
try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
(Either SomeException [T.Text])
case m of
Left _e2 -> return $ Left "Failed to migrate data tables"
Right _ -> return $ Right True
Right _ -> return $ Right False
initPool :: T.Text -> NoLoggingT IO ConnectionPool initPool :: T.Text -> NoLoggingT IO ConnectionPool
initPool dbPath = do initPool dbPath = do
@ -293,6 +467,36 @@ getWallets pool n =
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n)) where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
pure wallets pure wallets
walletExists :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashWallet))
walletExists pool n =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
wallets <- from $ table @ZcashWallet
where_ (wallets ^. ZcashWalletId ==. val (toSqlKey $ fromIntegral n))
pure wallets
getNetwork :: ConnectionPool -> WalletAddressId -> IO ZcashNet
getNetwork pool a = do
n <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
(wallet :& acc :& addr) <-
from $ table @ZcashWallet `innerJoin` table @ZcashAccount `on`
(\(wallet :& acc) ->
wallet ^. ZcashWalletId ==. acc ^. ZcashAccountWalletId) `innerJoin`
table @WalletAddress `on`
(\(_ :& acc :& addr) ->
acc ^. ZcashAccountId ==. addr ^. WalletAddressAccId)
where_ (addr ^. WalletAddressId ==. val a)
pure $ wallet ^. ZcashWalletNetwork
case n of
Nothing -> throwIO $ userError "Failed to find wallet"
Just (Value n') -> return $ getNet n'
-- | Save a new wallet to the database -- | Save a new wallet to the database
saveWallet :: saveWallet ::
ConnectionPool -- ^ The database path to use ConnectionPool -- ^ The database path to use
@ -367,14 +571,17 @@ saveAccount pool a =
-- | Returns the largest block in storage -- | Returns the largest block in storage
getMaxBlock :: getMaxBlock ::
Pool SqlBackend -- ^ The database pool Pool SqlBackend -- ^ The database pool
-> NoLoggingT IO Int -> ZcashNetDB
getMaxBlock pool = do -> IO Int
getMaxBlock pool net = do
b <- b <-
runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
txs <- from $ table @ZcashTransaction txs <- from $ table @ZcashTransaction
where_ (txs ^. ZcashTransactionBlock >. val 0) where_ (txs ^. ZcashTransactionBlock >. val 0)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy [desc $ txs ^. ZcashTransactionBlock] orderBy [desc $ txs ^. ZcashTransactionBlock]
pure txs pure txs
case b of case b of
@ -474,15 +681,16 @@ saveAddress pool w =
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path
-> Int -- ^ block time -> Int -- ^ block time
-> ZcashNetDB -- ^ the network
-> Transaction -- ^ The transaction to save -> Transaction -- ^ The transaction to save
-> NoLoggingT IO (Key ZcashTransaction) -> NoLoggingT IO (Key ZcashTransaction)
saveTransaction pool t wt = saveTransaction pool t n wt =
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
let ix = [0 ..] let ix = [0 ..]
w <- w <-
insert $ insert $
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
when (isJust $ tx_transpBundle wt) $ do when (isJust $ tx_transpBundle wt) $ do
_ <- _ <-
insertMany_ $ insertMany_ $
@ -561,14 +769,16 @@ saveTransaction pool t wt =
getZcashTransactions :: getZcashTransactions ::
ConnectionPool -- ^ The database path ConnectionPool -- ^ The database path
-> Int -- ^ Block -> Int -- ^ Block
-> ZcashNet -- ^ Network
-> IO [Entity ZcashTransaction] -> IO [Entity ZcashTransaction]
getZcashTransactions pool b = getZcashTransactions pool b net =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
select $ do select $ do
txs <- from $ table @ZcashTransaction txs <- from $ table @ZcashTransaction
where_ $ txs ^. ZcashTransactionBlock >. val b where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
orderBy [asc $ txs ^. ZcashTransactionBlock] orderBy [asc $ txs ^. ZcashTransactionBlock]
return txs return txs
@ -748,9 +958,10 @@ saveWalletOrchNote pool wId pos wit ch za zt dn = do
findTransparentNotes :: findTransparentNotes ::
ConnectionPool -- ^ The database path ConnectionPool -- ^ The database path
-> Int -- ^ Starting block -> Int -- ^ Starting block
-> ZcashNetDB -- ^ Network to use
-> Entity WalletAddress -> Entity WalletAddress
-> IO () -> IO ()
findTransparentNotes pool b t = do findTransparentNotes pool b net t = do
let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t) let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
case tReceiver of case tReceiver of
Just tR -> do Just tR -> do
@ -770,6 +981,7 @@ findTransparentNotes pool b t = do
(\(txs :& tNotes) -> (\(txs :& tNotes) ->
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx) txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
where_ (txs ^. ZcashTransactionBlock >. val b) where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
where_ (tNotes ^. TransparentNoteScript ==. val s) where_ (tNotes ^. TransparentNoteScript ==. val s)
pure (txs, tNotes) pure (txs, tNotes)
mapM_ mapM_
@ -823,8 +1035,9 @@ saveSapNote pool wsn =
getShieldedOutputs :: getShieldedOutputs ::
ConnectionPool -- ^ database path ConnectionPool -- ^ database path
-> Int -- ^ block -> Int -- ^ block
-> ZcashNetDB -- ^ network to use
-> IO [(Entity ZcashTransaction, Entity ShieldOutput)] -> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
getShieldedOutputs pool b = getShieldedOutputs pool b net =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
@ -834,6 +1047,7 @@ getShieldedOutputs pool b =
(\(txs :& sOutputs) -> (\(txs :& sOutputs) ->
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
where_ (txs ^. ZcashTransactionBlock >=. val b) where_ (txs ^. ZcashTransactionBlock >=. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy orderBy
[ asc $ txs ^. ZcashTransactionId [ asc $ txs ^. ZcashTransactionId
, asc $ sOutputs ^. ShieldOutputPosition , asc $ sOutputs ^. ShieldOutputPosition
@ -844,8 +1058,9 @@ getShieldedOutputs pool b =
getOrchardActions :: getOrchardActions ::
ConnectionPool -- ^ database path ConnectionPool -- ^ database path
-> Int -- ^ block -> Int -- ^ block
-> ZcashNetDB -- ^ network to use
-> IO [(Entity ZcashTransaction, Entity OrchAction)] -> IO [(Entity ZcashTransaction, Entity OrchAction)]
getOrchardActions pool b = getOrchardActions pool b net =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
@ -855,10 +1070,97 @@ getOrchardActions pool b =
(\(txs :& oActions) -> (\(txs :& oActions) ->
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
where_ (txs ^. ZcashTransactionBlock >=. val b) where_ (txs ^. ZcashTransactionBlock >=. val b)
where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy orderBy
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
pure (txs, oActions) pure (txs, oActions)
findNotesByAddress ::
ConnectionPool -> ValidAddress -> Entity WalletAddress -> IO [ZcashNoteAPI]
findNotesByAddress pool va addr = do
let ua =
isValidUnifiedAddress
((TE.encodeUtf8 . getUA . walletAddressUAddress . entityVal) addr)
case ua of
Just ua' -> do
if compareAddress va ua'
then do
case va of
Unified _ -> getWalletNotes pool addr
ZcashHaskell.Types.Sapling s -> do
n <- getSapNotes pool $ sa_receiver s
mapM (sapToZcashNoteAPI pool) n
ZcashHaskell.Types.Transparent t -> do
n <- getTrNotes pool $ ta_receiver t
mapM (trToZcashNoteAPI pool) n
Exchange e -> do
n <- getTrNotes pool $ ex_address e
mapM (trToZcashNoteAPI pool) n
else return []
Nothing -> return []
getTrNotes :: ConnectionPool -> TransparentReceiver -> IO [Entity WalletTrNote]
getTrNotes pool tr = do
let s =
BS.concat
[ BS.pack [0x76, 0xA9, 0x14]
, (toBytes . tr_bytes) tr
, BS.pack [0x88, 0xAC]
]
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes
getSapNotes :: ConnectionPool -> SaplingReceiver -> IO [Entity WalletSapNote]
getSapNotes pool sr = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
pure snotes
getOrchNotes :: ConnectionPool -> OrchardReceiver -> IO [Entity WalletOrchNote]
getOrchNotes pool o = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
pure onotes
getWalletNotes ::
ConnectionPool -- ^ database path
-> Entity WalletAddress
-> IO [ZcashNoteAPI]
getWalletNotes pool w = do
let w' = entityVal w
let tReceiver = t_rec =<< readUnifiedAddressDB w'
let sReceiver = s_rec =<< readUnifiedAddressDB w'
let oReceiver = o_rec =<< readUnifiedAddressDB w'
trNotes <-
case tReceiver of
Nothing -> return []
Just tR -> getTrNotes pool tR
sapNotes <-
case sReceiver of
Nothing -> return []
Just sR -> getSapNotes pool sR
orchNotes <-
case oReceiver of
Nothing -> return []
Just oR -> getOrchNotes pool oR
trNotes' <- mapM (trToZcashNoteAPI pool) trNotes
sapNotes' <- mapM (sapToZcashNoteAPI pool) sapNotes
orchNotes' <- mapM (orchToZcashNoteAPI pool) orchNotes
return $ trNotes' <> sapNotes' <> orchNotes'
-- | Get the transactions belonging to the given address -- | Get the transactions belonging to the given address
getWalletTransactions :: getWalletTransactions ::
ConnectionPool -- ^ database path ConnectionPool -- ^ database path
@ -876,35 +1178,11 @@ getWalletTransactions pool w = do
trNotes <- trNotes <-
case tReceiver of case tReceiver of
Nothing -> return [] Nothing -> return []
Just tR -> do Just tR -> liftIO $ getTrNotes pool tR
let s =
BS.concat
[ BS.pack [0x76, 0xA9, 0x14]
, (toBytes . tr_bytes) tR
, BS.pack [0x88, 0xAC]
]
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes
trChgNotes <- trChgNotes <-
case ctReceiver of case ctReceiver of
Nothing -> return [] Nothing -> return []
Just tR -> do Just tR -> liftIO $ getTrNotes pool tR
let s1 =
BS.concat
[ BS.pack [0x76, 0xA9, 0x14]
, (toBytes . tr_bytes) tR
, BS.pack [0x88, 0xAC]
]
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s1)
pure tnotes
trSpends <- trSpends <-
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
@ -917,44 +1195,20 @@ getWalletTransactions pool w = do
sapNotes <- sapNotes <-
case sReceiver of case sReceiver of
Nothing -> return [] Nothing -> return []
Just sR -> do Just sR -> liftIO $ getSapNotes pool sR
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes
sapChgNotes <- sapChgNotes <-
case csReceiver of case csReceiver of
Nothing -> return [] Nothing -> return []
Just sR -> do Just sR -> liftIO $ getSapNotes pool sR
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes
sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes) sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
orchNotes <- orchNotes <-
case oReceiver of case oReceiver of
Nothing -> return [] Nothing -> return []
Just oR -> do Just oR -> liftIO $ getOrchNotes pool oR
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
pure onotes
orchChgNotes <- orchChgNotes <-
case coReceiver of case coReceiver of
Nothing -> return [] Nothing -> return []
Just oR -> do Just oR -> liftIO $ getOrchNotes pool oR
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
pure onotes
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes) orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
clearUserTx (entityKey w) clearUserTx (entityKey w)
mapM_ addTr trNotes mapM_ addTr trNotes
@ -1087,6 +1341,19 @@ getWalletTransactions pool w = do
where_ (t ^. UserTxId ==. val (entityKey uTx)) where_ (t ^. UserTxId ==. val (entityKey uTx))
return () return ()
getWalletTransaction ::
ConnectionPool
-> WalletTransactionId
-> IO (Maybe (Entity WalletTransaction))
getWalletTransaction pool i =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
trs <- from $ table @WalletTransaction
where_ (trs ^. WalletTransactionId ==. val i)
pure trs
getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx] getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx]
getUserTx pool aId = do getUserTx pool aId = do
runNoLoggingT $ runNoLoggingT $
@ -1146,7 +1413,7 @@ findTransparentSpends pool za = do
(trSpends ^. TransparentSpendOutPointHash ==. val flipTxId) (trSpends ^. TransparentSpendOutPointHash ==. val flipTxId)
where_ where_
(trSpends ^. TransparentSpendOutPointIndex ==. (trSpends ^. TransparentSpendOutPointIndex ==.
val (walletTrNotePosition $ entityVal n)) val (fromIntegral $ walletTrNotePosition $ entityVal n))
pure (tx, trSpends) pure (tx, trSpends)
if null s if null s
then return () then return ()
@ -1383,6 +1650,34 @@ upsertWalTx zt za =
(zcashTransactionTime zt)) (zcashTransactionTime zt))
[] []
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
getSaplingOutIndex pool i = do
o <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
sout <- from $ table @ShieldOutput
where_ (sout ^. ShieldOutputId ==. val i)
pure $ sout ^. ShieldOutputPosition
case o of
Nothing -> throwIO $ userError "couldn't find shielded output"
Just (Value o') -> return o'
getOrchardOutIndex :: ConnectionPool -> OrchActionId -> IO Int
getOrchardOutIndex pool i = do
o <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
sout <- from $ table @OrchAction
where_ (sout ^. OrchActionId ==. val i)
pure $ sout ^. OrchActionPosition
case o of
Nothing -> throwIO $ userError "couldn't find orchard action"
Just (Value o') -> return o'
getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
getBalance pool za = do getBalance pool za = do
trNotes <- getWalletUnspentTrNotes pool za trNotes <- getWalletUnspentTrNotes pool za
@ -1425,6 +1720,32 @@ getUnconfirmedBalance pool za = do
let oBal = sum oAmts let oBal = sum oAmts
return . fromIntegral $ tBal + sBal + oBal return . fromIntegral $ tBal + sBal + oBal
getPoolBalance :: ConnectionPool -> ZcashAccountId -> IO AccountBalance
getPoolBalance pool za = do
trNotes <- getWalletUnspentTrNotes pool za
let tAmts = map (walletTrNoteValue . entityVal) trNotes
let tBal = sum tAmts
sapNotes <- getWalletUnspentSapNotes pool za
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
let sBal = sum sAmts
orchNotes <- getWalletUnspentOrchNotes pool za
let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
let oBal = sum oAmts
return $ AccountBalance tBal sBal oBal
getUnconfPoolBalance :: ConnectionPool -> ZcashAccountId -> IO AccountBalance
getUnconfPoolBalance pool za = do
trNotes <- getWalletUnspentUnconfirmedTrNotes pool za
let tAmts = map (walletTrNoteValue . entityVal) trNotes
let tBal = sum tAmts
sapNotes <- getWalletUnspentUnconfirmedSapNotes pool za
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
let sBal = sum sAmts
orchNotes <- getWalletUnspentUnconfirmedOrchNotes pool za
let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
let oBal = sum oAmts
return $ AccountBalance tBal sBal oBal
clearWalletTransactions :: ConnectionPool -> IO () clearWalletTransactions :: ConnectionPool -> IO ()
clearWalletTransactions pool = do clearWalletTransactions pool = do
runNoLoggingT $ runNoLoggingT $
@ -1454,6 +1775,32 @@ clearWalletTransactions pool = do
delete $ do delete $ do
_ <- from $ table @WalletTransaction _ <- from $ table @WalletTransaction
return () return ()
update $ \w -> do
set w [ZcashWalletLastSync =. val 0]
clearWalletData :: ConnectionPool -> IO ()
clearWalletData pool = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
delete $ do
_ <- from $ table @TransparentNote
return ()
delete $ do
_ <- from $ table @TransparentSpend
return ()
delete $ do
_ <- from $ table @OrchAction
return ()
delete $ do
_ <- from $ table @ShieldOutput
return ()
delete $ do
_ <- from $ table @ShieldSpend
return ()
delete $ do
_ <- from $ table @ZcashTransaction
return ()
getWalletUnspentTrNotes :: getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
@ -1610,7 +1957,7 @@ selectUnspentNotes pool za amt = do
else return (tList, [], []) else return (tList, [], [])
where where
checkTransparent :: checkTransparent ::
Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote]) Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
checkTransparent x [] = (x, []) checkTransparent x [] = (x, [])
checkTransparent x (n:ns) = checkTransparent x (n:ns) =
if walletTrNoteValue (entityVal n) < x if walletTrNoteValue (entityVal n) < x
@ -1619,7 +1966,7 @@ selectUnspentNotes pool za amt = do
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)) snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
else (0, [n]) else (0, [n])
checkSapling :: checkSapling ::
Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote]) Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
checkSapling x [] = (x, []) checkSapling x [] = (x, [])
checkSapling x (n:ns) = checkSapling x (n:ns) =
if walletSapNoteValue (entityVal n) < x if walletSapNoteValue (entityVal n) < x
@ -1627,7 +1974,7 @@ selectUnspentNotes pool za amt = do
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns)) , n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
else (0, [n]) else (0, [n])
checkOrchard :: checkOrchard ::
Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote]) Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
checkOrchard x [] = (x, []) checkOrchard x [] = (x, [])
checkOrchard x (n:ns) = checkOrchard x (n:ns) =
if walletOrchNoteValue (entityVal n) < x if walletOrchNoteValue (entityVal n) < x
@ -1724,3 +2071,37 @@ deleteAdrsFromAB pool ia = do
rmdups :: Ord a => [a] -> [a] rmdups :: Ord a => [a] -> [a]
rmdups = map head . group . sort rmdups = map head . group . sort
-- * Zenith Operations
-- | Get an operation by UUID
getOperation :: ConnectionPool -> U.UUID -> IO (Maybe (Entity Operation))
getOperation pool uid = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
ops <- from $ table @Operation
where_ (ops ^. OperationUuid ==. val (ZenithUuid uid))
pure ops
-- | Save an operation
saveOperation :: ConnectionPool -> Operation -> IO (Maybe (Key Operation))
saveOperation pool op = do
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUnique op
-- | Finalize an operation with either a successful result or an error
finalizeOperation ::
ConnectionPool -> Key Operation -> ZenithStatus -> T.Text -> IO ()
finalizeOperation pool op status result = do
tstamp <- getCurrentTime
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $
update $ \ops -> do
set
ops
[ OperationEnd =. val (Just tstamp)
, OperationStatus =. val status
, OperationResult =. val (Just result)
]
where_ (ops ^. OperationId ==. val op)

View file

@ -1,5 +1,6 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
module Zenith.GUI where module Zenith.GUI where
@ -9,17 +10,17 @@ import Codec.QRCode
import Codec.QRCode.JuicyPixels import Codec.QRCode.JuicyPixels
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (toText) import Data.HexString (toText)
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) import Data.Maybe (fromMaybe, isJust, isNothing)
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)
import Database.Esqueleto.Experimental (ConnectionPool) import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
import Database.Persist import Database.Persist
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
import Lens.Micro.TH import Lens.Micro.TH
@ -27,7 +28,6 @@ import Monomer
import qualified Monomer.Lens as L import qualified Monomer.Lens as L
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.FilePath ((</>)) import System.FilePath ((</>))
import System.Hclip
import Text.Printf import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText) import TextShow hiding (toText)
@ -36,7 +36,6 @@ import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
, Phrase(..)
, Scope(..) , Scope(..)
, ToBytes(..) , ToBytes(..)
, UnifiedAddress(..) , UnifiedAddress(..)
@ -48,15 +47,20 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.GUI.Theme import Zenith.GUI.Theme
import Zenith.Scanner (processTx, updateConfs) import Zenith.Scanner (processTx, rescanZebra, updateConfs)
import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils import Zenith.Utils
( displayAmount ( displayAmount
, getZenithPath
, isEmpty
, isRecipientValid , isRecipientValid
, isValidString
, jsonNumber , jsonNumber
, padWithZero
, parseAddress , parseAddress
, showAddress , showAddress
, validBarValue , validBarValue
, validateAddressBool
) )
data AppEvent data AppEvent
@ -102,6 +106,25 @@ data AppEvent
| CheckRecipient !T.Text | CheckRecipient !T.Text
| CheckAmount !Float | CheckAmount !Float
| ShowTxId !T.Text | ShowTxId !T.Text
| LoadAbList ![Entity AddressBook]
| ShowAdrBook
| CloseAdrBook
| NewAdrBkEntry
| CloseNewAdrBook
| NotImplemented
| CloseMsgAB
| CheckValidAddress !T.Text
| CheckValidDescrip !T.Text
| SaveNewABEntry
| SaveABDescription !T.Text
| UpdateABEntry !T.Text !T.Text
| CloseUpdABEntry
| ShowMessage !T.Text
| ShowABAddress !T.Text !T.Text
| CloseShowABAddress
| CopyABAdress !T.Text
| DeleteABEntry !T.Text
| UpdateABDescrip !T.Text !T.Text
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -144,6 +167,16 @@ data AppModel = AppModel
, _amountValid :: !Bool , _amountValid :: !Bool
, _showId :: !(Maybe T.Text) , _showId :: !(Maybe T.Text)
, _home :: !FilePath , _home :: !FilePath
, _showAdrBook :: !Bool
, _newAdrBkEntry :: !Bool
, _abdescrip :: !T.Text
, _abaddress :: !T.Text
, _abAddressValid :: !Bool
, _abDescripValid :: !Bool
, _abaddressList :: ![Entity AddressBook]
, _msgAB :: !(Maybe T.Text)
, _showABAddress :: !Bool
, _updateABAddress :: !Bool
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -185,6 +218,15 @@ buildUI wenv model = widgetTree
, txIdOverlay `nodeVisible` isJust (model ^. showId) , txIdOverlay `nodeVisible` isJust (model ^. showId)
, msgOverlay `nodeVisible` isJust (model ^. msg) , msgOverlay `nodeVisible` isJust (model ^. msg)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
, adrbookOverlay `nodeVisible` model ^. showAdrBook
, newAdrBkOverlay `nodeVisible` model ^. newAdrBkEntry
, showABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
model ^.
showABAddress
, updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
model ^.
updateABAddress
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
] ]
mainWindow = mainWindow =
vstack vstack
@ -247,6 +289,8 @@ buildUI wenv model = widgetTree
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic` , box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
]) `styleBasic` ]) `styleBasic`
[bgColor btnColor, padding 3] [bgColor btnColor, padding 3]
newBox = newBox =
@ -750,6 +794,146 @@ buildUI wenv model = widgetTree
] ]
]) `styleBasic` ]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray] [padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray]
-- |
-- | Address Book overlays
-- |
adrbookOverlay =
alert CloseAdrBook $
vstack
[ box_
[]
(label "Address Book" `styleBasic`
[textFont "Bold", textSize 12, textColor white]) `styleBasic`
[bgColor btnColor, radius 2, padding 3]
, boxShadow $
box_
[alignMiddle]
(vstack
[ vscroll
(vstack (zipWith abookRow [0 ..] (model ^. abaddressList))) `nodeKey`
"txScroll"
]) `styleBasic`
[radius 2, padding 3, bgColor white]
, spacer
, hstack [button "New" NewAdrBkEntry]
]
abookRow :: Int -> Entity AddressBook -> WidgetNode AppModel AppEvent
abookRow idx ab =
box_
[ onClick $
ShowABAddress
(addressBookAbdescrip $ entityVal ab)
(addressBookAbaddress $ entityVal ab)
, alignLeft
]
(hstack
[ label (T.pack $ padWithZero 3 $ show (fromSqlKey (entityKey ab))) `styleBasic`
[textFont "Bold"]
, spacer
, label (addressBookAbdescrip $ entityVal ab)
]) `styleBasic`
[padding 2, borderB 1 gray]
newAdrBkOverlay =
alert CloseNewAdrBook $
vstack
[ box_
[]
(label "New Address Book Entry" `styleBasic`
[textFont "Bold", textSize 10, textColor white]) `styleBasic`
[bgColor btnColor, radius 2, padding 3]
, spacer
, hstack
[ label "Description: " `styleBasic` [width 80]
, spacer
, textField_ abdescrip [onChange CheckValidDescrip] `styleBasic`
[ width 320
, styleIf (not $ model ^. abDescripValid) (textColor red)
]
]
, spacer
, hstack
[ label "Address:" `styleBasic` [width 50]
, spacer
, textField_ abaddress [onChange CheckValidAddress] `styleBasic`
[ width 350
, styleIf (not $ model ^. abAddressValid) (textColor red)
]
]
, spacer
, hstack
[ button "Save" SaveNewABEntry `nodeEnabled`
((model ^. abAddressValid) && (model ^. abDescripValid))
, spacer
, button "Cancel" CloseNewAdrBook `nodeEnabled` True
]
]
updateABAddressOverlay abd aba =
alert CloseUpdABEntry $
vstack
[ box_
[]
(label "Edit Address Description" `styleBasic`
[textFont "Bold", textSize 10, textColor white]) `styleBasic`
[bgColor btnColor, radius 2, padding 3]
, spacer
, hstack
[ label "Description:" `styleBasic` [width 80]
, spacer
, textField_ abdescrip [onChange CheckValidDescrip] `styleBasic`
[ width 320
, styleIf (not $ model ^. abDescripValid) (textColor red)
]
]
, spacer
, hstack
[ filler
, button "Save" (UpdateABDescrip abd aba) `nodeEnabled`
(model ^. abDescripValid)
, spacer
, button "Cancel" CloseUpdABEntry `nodeEnabled` True
, filler
]
]
showABAddressOverlay abd aba =
alert CloseShowABAddress $
vstack
[ box_
[]
(label "Address Book Entry" `styleBasic`
[textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic`
[bgColor btnColor, radius 2, padding 3]
, spacer
, hstack
[ filler
, label (txtWrapN abd 64) `styleBasic` [textFont "Bold"]
, filler
]
, spacer
, hstack [filler, label_ (txtWrapN aba 64) [multiline], filler]
, spacer
, hstack
[ filler
, button "Edit Description" $ UpdateABEntry abd aba
, spacer
, button "Copy Address" $ CopyABAdress aba
, spacer
, button "Delete Entry" $ DeleteABEntry aba
, filler
]
]
msgAdrBookOverlay =
alert CloseMsgAB $
hstack
[ filler
, remixIcon remixErrorWarningFill `styleBasic`
[textSize 32, textColor btnColor] `nodeVisible`
(model ^. inError)
, spacer
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
, filler
]
notImplemented = NotImplemented
generateQRCodes :: Config -> IO () generateQRCodes :: Config -> IO ()
generateQRCodes config = do generateQRCodes config = do
@ -1030,6 +1214,7 @@ handleEvent wenv node model evt =
(c_dbPath $ model ^. configuration) (c_dbPath $ model ^. configuration)
(c_zebraHost $ model ^. configuration) (c_zebraHost $ model ^. configuration)
(c_zebraPort $ model ^. configuration) (c_zebraPort $ model ^. configuration)
(model ^. network)
] ]
else [Model $ model & timer .~ 0] else [Model $ model & timer .~ 0]
SyncVal i -> SyncVal i ->
@ -1040,10 +1225,9 @@ handleEvent wenv node model evt =
Nothing -> return $ ShowError "No wallet available" Nothing -> return $ ShowError "No wallet available"
Just cW -> do Just cW -> do
syncWallet (model ^. configuration) cW syncWallet (model ^. configuration) cW
return $ SwitchAddr (model ^. selAddr)
, Task $ do
pool <- pool <-
runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration runNoLoggingT $
initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network) wL <- getWallets pool (model ^. network)
return $ LoadWallets wL return $ LoadWallets wL
] ]
@ -1060,6 +1244,85 @@ handleEvent wenv node model evt =
(i < (fromIntegral (model ^. balance) / 100000000.0)) (i < (fromIntegral (model ^. balance) / 100000000.0))
] ]
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing] ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
-- |
-- | Address Book Events
-- |
CheckValidAddress a ->
[Model $ model & abAddressValid .~ isRecipientValid a]
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
ShowAdrBook ->
if null (model ^. abaddressList)
then [Model $ model & newAdrBkEntry .~ True & menuPopup .~ False]
else [Model $ model & showAdrBook .~ True & menuPopup .~ False]
CloseAdrBook -> [Model $ model & showAdrBook .~ False]
NewAdrBkEntry ->
[Model $ model & newAdrBkEntry .~ True & menuPopup .~ False]
CloseNewAdrBook -> do
[Model $ model & newAdrBkEntry .~ False]
UpdateABEntry d a ->
[ Model $
model & abdescrip .~ d & abaddress .~ a & updateABAddress .~ True &
abDescripValid .~
True &
menuPopup .~
False
]
CloseUpdABEntry -> do
[Model $ model & updateABAddress .~ False]
SaveNewABEntry ->
[ Task $
saveAddrBook
(model ^. configuration)
(ZcashNetDB (model ^. network))
(model ^. abdescrip)
(model ^. abaddress)
, Model $
model & abdescrip .~ "" & abaddress .~ "" & newAdrBkEntry .~ False
, Task $ do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
abList <- getAdrBook dbPool $ model ^. network
return $ LoadAbList abList
]
ShowABAddress d a ->
[ Model $
model & abdescrip .~ d & abaddress .~ a & showABAddress .~ True &
menuPopup .~
False
]
CloseShowABAddress ->
[Model $ model & showABAddress .~ False & inError .~ False]
CopyABAdress a ->
[ setClipboardData ClipboardEmpty
, setClipboardData $ ClipboardText a
, Event $ ShowMessage "Address copied!!"
]
DeleteABEntry a ->
[ Task $ deleteAdrBook (model ^. configuration) a
, Model $
model & abdescrip .~ "" & abaddress .~ "" & showABAddress .~ False
, Task $ do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
abList <- getAdrBook dbPool $ model ^. network
return $ LoadAbList abList
]
ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False]
NotImplemented ->
[ Model $
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
]
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
LoadAbList a -> [Model $ model & abaddressList .~ a]
UpdateABDescrip d a ->
[ Task $ updAddrBookDescrip (model ^. configuration) d a
, Model $
model & abdescrip .~ "" & abaddress .~ "" & updateABAddress .~ False &
showABAddress .~
False
, Task $ do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
abList <- getAdrBook dbPool $ model ^. network
return $ LoadAbList abList
]
where where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -1147,14 +1410,39 @@ handleEvent wenv node model evt =
Just _ -> do Just _ -> do
wL <- getWallets pool (model ^. network) wL <- getWallets pool (model ^. network)
return $ LoadWallets wL return $ LoadWallets wL
-- |
-- | Address Book -> save new entry into database
-- |
saveAddrBook :: Config -> ZcashNetDB -> T.Text -> T.Text -> IO AppEvent
saveAddrBook config n d a = do
pool <- runNoLoggingT $ initPool $ c_dbPath config
res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook n d a
case res of
Nothing -> return $ ShowMessage "Error saving AddressBook entry..."
Just _ -> return $ ShowMessage "New Address Book entry added!!"
-- |
-- | Address Book -> save new entry into database
-- |
deleteAdrBook :: Config -> T.Text -> IO AppEvent
deleteAdrBook config a = do
pool <- runNoLoggingT $ initPool $ c_dbPath config
res <- liftIO $ deleteAdrsFromAB pool a
return $ ShowMessage "Address Book entry deleted!!"
-- |
-- | Address Book -> save new entry into database
-- |
updAddrBookDescrip :: Config -> T.Text -> T.Text -> IO AppEvent
updAddrBookDescrip config d a = do
pool <- runNoLoggingT $ initPool $ c_dbPath config
res <- liftIO $ updateAdrsInAdrBook pool d a a
return $ ShowMessage "Address Book entry updated!!"
scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO () scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort sendMsg = do scanZebra dbPath zHost zPort net sendMsg = do
_ <- liftIO $ initDb dbPath
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- getMaxBlock pool $ ZcashNetDB net
let sb = max dbBlock b let sb = max dbBlock b
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of case confUp of
@ -1193,7 +1481,7 @@ scanZebra dbPath zHost zPort sendMsg = do
Left e2 -> sendMsg (ShowError $ showt e2) Left e2 -> sendMsg (ShowError $ showt e2)
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
sendMsg (SyncVal step) sendMsg (SyncVal step)
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
@ -1246,6 +1534,9 @@ timeTicker sendMsg = do
threadDelay $ 1000 * 1000 threadDelay $ 1000 * 1000
timeTicker sendMsg timeTicker sendMsg
txtWrapN :: T.Text -> Int -> T.Text
txtWrapN t n = wrapText (WrapSettings False True NoFill FillAfterFirst) n t
txtWrap :: T.Text -> T.Text txtWrap :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
@ -1268,7 +1559,11 @@ runZenithGUI 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
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra host port dbFilePath
generateQRCodes config generateQRCodes config
walList <- getWallets pool $ zgb_net chainInfo walList <- getWallets pool $ zgb_net chainInfo
accList <- accList <-
@ -1297,6 +1592,7 @@ runZenithGUI 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
abList <- getAdrBook pool (zgb_net chainInfo)
let model = let model =
AppModel AppModel
config config
@ -1343,53 +1639,18 @@ runZenithGUI config = do
False False
Nothing Nothing
hD hD
False
False
""
""
False
False
abList
Nothing
False
False
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left e -> do Left _e -> print "Zebra not available"
initDb dbFilePath
let model =
AppModel
config
TestNet
[]
0
[]
0
[]
0
[]
0
(Just $
"Couldn't connect to Zebra on " <>
host <> ":" <> showt port <> ". Check your configuration.")
False
314259000
(Just 30000)
Orchard
Nothing
False
False
False
False
""
Nothing
""
""
(SaveAddress Nothing)
False
False
Nothing
Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
hD
startApp model handleEvent buildUI (params hD)
where where
params hd = params hd =
[ appWindowTitle "Zenith - Zcash Full Node Wallet" [ appWindowTitle "Zenith - Zcash Full Node Wallet"

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 &

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

@ -0,0 +1,696 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.RPC where
import Control.Exception (try)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson
import Data.Int
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.UUID as U
import qualified Data.Vector as V
import Database.Esqueleto.Experimental
( entityKey
, entityVal
, fromSqlKey
, toSqlKey
)
import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
import Zenith.DB
( Operation(..)
, ZcashAccount(..)
, ZcashWallet(..)
, findNotesByAddress
, getAccountById
, getAccounts
, getAddressById
, getAddresses
, getExternalAddresses
, getMaxAccount
, getMaxAddress
, getOperation
, getPoolBalance
, getUnconfPoolBalance
, getWalletNotes
, getWallets
, initPool
, saveAccount
, saveAddress
, saveWallet
, toZcashAccountAPI
, toZcashAddressAPI
, toZcashWalletAPI
, walletExists
)
import Zenith.Types
( AccountBalance(..)
, Config(..)
, PhraseDB(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashWalletAPI(..)
, ZenithUuid(..)
)
import Zenith.Utils (jsonNumber)
data ZenithMethod
= GetInfo
| ListWallets
| ListAccounts
| ListAddresses
| ListReceived
| GetBalance
| GetNewWallet
| GetNewAccount
| GetNewAddress
| GetOperationStatus
| 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 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
_ -> 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
| 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]
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
| 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
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'
_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
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
sP <- liftIO generateWalletSeedPhrase
pool <- liftIO $ runNoLoggingT $ initPool dbPath
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
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
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"
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]

View file

@ -2,29 +2,22 @@
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 (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
( LoggingT
, NoLoggingT
, logErrorN
, logInfoN
, runNoLoggingT
)
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 +25,68 @@ 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)
import Zenith.DB import Zenith.DB
( getMaxBlock ( clearWalletData
, clearWalletTransactions
, getMaxBlock
, getMinBirthdayHeight
, getUnconfirmedBlocks , getUnconfirmedBlocks
, getWallets
, initDb , initDb
, initPool
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, updateWalletSync
) )
import Zenith.Types (Config(..), ZcashNetDB(..))
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 clearWalletTransactions pool1
clearWalletData pool1
dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1
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) print "Rescan complete"
Right txList' -> logInfoN "Finished scan"
-- | 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 +94,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
@ -116,7 +119,7 @@ processBlock host port pool pg b = do
Left e2 -> liftIO $ throwIO $ userError e2 Left e2 -> liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime pool) $ mapM_ (processTx host port blockTime pool net) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ tick pg liftIO $ tick pg
where where
@ -134,9 +137,10 @@ processTx ::
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> Int -- ^ Block time -> Int -- ^ Block time
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> ZcashNetDB -- ^ the network
-> HexString -- ^ transaction id -> HexString -- ^ transaction id
-> NoLoggingT IO () -> IO ()
processTx host port bt pool t = do processTx host port bt pool net t = do
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
@ -151,7 +155,8 @@ processTx host port bt pool t = do
Nothing -> return () Nothing -> return ()
Just rzt -> do Just rzt -> do
_ <- _ <-
saveTransaction pool bt $ runNoLoggingT $
saveTransaction pool bt net $
Transaction Transaction
t t
(ztr_blockheight rawTx) (ztr_blockheight rawTx)
@ -184,3 +189,27 @@ 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
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 <- mapM (syncWallet config) w'
liftIO $ print r

View file

@ -10,14 +10,17 @@
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 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.Types import ZcashHaskell.Types
@ -42,6 +45,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 +98,114 @@ 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
= Transparent
| Sprout
| Sapling
| Orchard
deriving (Show, Read, Eq)
derivePersistField "ZcashPool"
instance ToJSON ZcashPool where
toJSON zp =
case zp of
Transparent -> Data.Aeson.String "p2pkh"
Sprout -> Data.Aeson.String "sprout"
Sapling -> Data.Aeson.String "sapling"
Orchard -> Data.Aeson.String "orchard"
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"
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
= Full
| Medium
| Low
| None
$(deriveJSON defaultOptions ''PrivacyPolicy)
-- ** `zebrad` -- ** `zebrad`
-- | Type for modeling the tree state response -- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo data ZebraTreeInfo = ZebraTreeInfo
@ -138,24 +250,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]

View file

@ -9,6 +9,8 @@ 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 Data.Char (isAlphaNum, isSpace)
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)
@ -83,6 +85,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,6 +99,12 @@ 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)
@ -103,7 +118,7 @@ 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)
@ -120,3 +135,30 @@ 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

650
test/ServerSpec.hs Normal file
View file

@ -0,0 +1,650 @@
{-# 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 (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)
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(..)
, 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"
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)

View file

@ -195,7 +195,7 @@ main = do
(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))
it "Sapling" $ do it "Sapling" $ do
@ -209,7 +209,7 @@ main = do
(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 (En.encodeUtf8 a) of
Just _a4 -> True Just _a4 -> True
Nothing -> False)) Nothing -> False))
it "Transparent" $ do it "Transparent" $ do
@ -222,7 +222,7 @@ main = do
(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))
it "Check Sapling Address" $ do it "Check Sapling Address" $ do

@ -1 +1 @@
Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2 Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c

878
zenith-openrpc.json Normal file
View file

@ -0,0 +1,878 @@
{
"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/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/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/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 or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
"tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
"params": [
{ "$ref": "#/components/contentDescriptors/AccountId"},
{ "$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 one transaction",
"description": "Send a single transaction",
"params": [
{
"name": "Account index",
"summary": "The index for the account to use",
"value": "1"
},
{
"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/InvalidRecipient" },
{ "$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"}
}
}
},
"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"},
"privacy": { "type": "string", "enum": ["None", "Low", "Medium", "Full"], "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 and deshielding transactions. `Low` allows to spend transparent funds into shielded pools. `None` allows for transparent funds to be spent to transparent addresses."}
}
}
},
"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."
}
}
}
}

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,62 @@ library
Zenith.Utils Zenith.Utils
Zenith.Zcashd Zenith.Zcashd
Zenith.Scanner Zenith.Scanner
Zenith.RPC
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
, 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
, 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 +116,18 @@ 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 , wai-extra
, warp
, servant-server
, zcash-haskell
, zenith , zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010
@ -148,3 +157,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