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 1526 additions and 5105 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/

2
.gitmodules vendored
View file

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

View file

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

View file

@ -230,7 +230,6 @@ main = do
"gui" -> runZenithGUI myConfig "gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig "tui" -> runZenithTUI myConfig
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
"resync" -> clearSync myConfig
_ -> printUsage _ -> printUsage
else printUsage else printUsage

View file

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

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

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

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

View file

@ -1,7 +1,6 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-} {-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.GUI where module Zenith.GUI where
@ -11,20 +10,13 @@ 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 (forM_, unless, when) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
( LoggingT
, NoLoggingT
, logDebugN
, runNoLoggingT
, runStderrLoggingT
)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString (toText) import Data.HexString (toText)
import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Scientific (Scientific, fromFloatDigits)
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)
@ -40,21 +32,13 @@ 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)
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
( getSaplingFromUA import ZcashHaskell.Transparent (encodeTransparentReceiver)
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
, Scope(..) , Scope(..)
, ToBytes(..) , ToBytes(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
, ZebraGetInfo(..) , ZebraGetInfo(..)
@ -63,18 +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 (checkIntegrity, processTx, rescanZebra, 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
, getChainTip , getZenithPath
, isRecipientValidGUI , isEmpty
, isRecipientValid
, isValidString , isValidString
, isZecAddressValid
, jsonNumber , jsonNumber
, padWithZero , padWithZero
, parseAddress
, showAddress , showAddress
, validBarValue , validBarValue
, validateAddressBool
) )
data AppEvent data AppEvent
@ -95,7 +81,7 @@ data AppEvent
| SwitchAddr !Int | SwitchAddr !Int
| SwitchAcc !Int | SwitchAcc !Int
| SwitchWal !Int | SwitchWal !Int
| UpdateBalance !(Integer, Integer, Integer, Integer) | UpdateBalance !(Integer, Integer)
| CopyAddr !(Maybe (Entity WalletAddress)) | CopyAddr !(Maybe (Entity WalletAddress))
| LoadTxs ![Entity UserTx] | LoadTxs ![Entity UserTx]
| LoadAddrs ![Entity WalletAddress] | LoadAddrs ![Entity WalletAddress]
@ -130,6 +116,7 @@ data AppEvent
| CheckValidAddress !T.Text | CheckValidAddress !T.Text
| CheckValidDescrip !T.Text | CheckValidDescrip !T.Text
| SaveNewABEntry | SaveNewABEntry
| SaveABDescription !T.Text
| UpdateABEntry !T.Text !T.Text | UpdateABEntry !T.Text !T.Text
| CloseUpdABEntry | CloseUpdABEntry
| ShowMessage !T.Text | ShowMessage !T.Text
@ -138,15 +125,6 @@ data AppEvent
| CopyABAdress !T.Text | CopyABAdress !T.Text
| DeleteABEntry !T.Text | DeleteABEntry !T.Text
| UpdateABDescrip !T.Text !T.Text | UpdateABDescrip !T.Text !T.Text
| ResetRecipientValid
| ShowShield
| CloseShield
| ShowDeShield
| CloseDeShield
| SendDeShield
| SendShield
| StartSync
| TreeSync
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -199,13 +177,6 @@ data AppModel = AppModel
, _msgAB :: !(Maybe T.Text) , _msgAB :: !(Maybe T.Text)
, _showABAddress :: !Bool , _showABAddress :: !Bool
, _updateABAddress :: !Bool , _updateABAddress :: !Bool
, _privacyChoice :: !PrivacyPolicy
, _shieldZec :: !Bool
, _deShieldZec :: !Bool
, _tBalance :: !Integer
, _tBalanceValid :: !Bool
, _sBalance :: !Integer
, _sBalanceValid :: !Bool
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -255,8 +226,6 @@ buildUI wenv model = widgetTree
, updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
model ^. model ^.
updateABAddress updateABAddress
, shieldOverlay `nodeVisible` model ^. shieldZec
, deShieldOverlay `nodeVisible` model ^. deShieldZec
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB) , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
] ]
mainWindow = mainWindow =
@ -322,10 +291,6 @@ buildUI wenv model = widgetTree
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic` , box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowShield] (label "Shield ZEC") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
]) `styleBasic` ]) `styleBasic`
[bgColor btnColor, padding 3] [bgColor btnColor, padding 3]
newBox = newBox =
@ -452,43 +417,43 @@ buildUI wenv model = widgetTree
[ vstack [ vstack
[ tooltip "Unified" $ [ tooltip "Unified" $
box_ box_
[onClick (SetPool OrchardPool)] [onClick (SetPool Orchard)]
(remixIcon remixShieldCheckFill `styleBasic` (remixIcon remixShieldCheckFill `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == OrchardPool) (model ^. selPool == Orchard)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == OrchardPool) (model ^. selPool == Orchard)
(textColor white) (textColor white)
]) ])
, filler , filler
, tooltip "Legacy Shielded" $ , tooltip "Legacy Shielded" $
box_ box_
[onClick (SetPool SaplingPool)] [onClick (SetPool Sapling)]
(remixIcon remixShieldLine `styleBasic` (remixIcon remixShieldLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == SaplingPool) (model ^. selPool == Sapling)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == SaplingPool) (model ^. selPool == Sapling)
(textColor white) (textColor white)
]) ])
, filler , filler
, tooltip "Transparent" $ , tooltip "Transparent" $
box_ box_
[onClick (SetPool TransparentPool)] [onClick (SetPool Transparent)]
(remixIcon remixEyeLine `styleBasic` (remixIcon remixEyeLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == TransparentPool) (model ^. selPool == Transparent)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == TransparentPool) (model ^. selPool == Transparent)
(textColor white) (textColor white)
]) ])
] `styleBasic` ] `styleBasic`
@ -501,10 +466,10 @@ buildUI wenv model = widgetTree
(hstack (hstack
[ label [ label
(case model ^. selPool of (case model ^. selPool of
OrchardPool -> "Unified" Orchard -> "Unified"
SaplingPool -> "Legacy Shielded" Sapling -> "Legacy Shielded"
TransparentPool -> "Transparent" Transparent -> "Transparent"
SproutPool -> "Unknown") `styleBasic` Sprout -> "Unknown") `styleBasic`
[textColor white] [textColor white]
, remixIcon remixFileCopyFill `styleBasic` , remixIcon remixFileCopyFill `styleBasic`
[textSize 14, padding 4, textColor white] [textSize 14, padding 4, textColor white]
@ -640,28 +605,7 @@ buildUI wenv model = widgetTree
, separatorLine `styleBasic` [fgColor btnColor] , separatorLine `styleBasic` [fgColor btnColor]
, spacer , spacer
, hstack , hstack
[ label "Privacy Level:" `styleBasic` [ label "To:" `styleBasic` [width 50]
[width 70, textFont "Bold"]
, spacer
, label "Full " `styleBasic` [width 40]
, radio Full privacyChoice
, spacer
, label "Medium " `styleBasic` [width 40]
, radio Medium privacyChoice
]
, hstack
[ label " " `styleBasic`
[width 70, textFont "Bold"]
, spacer
, label "Low " `styleBasic` [width 40]
, radio Low privacyChoice
, spacer
, label "None " `styleBasic` [width 40]
, radio None privacyChoice
]
, spacer
, hstack
[ label "To:" `styleBasic` [width 50, textFont "Bold"]
, spacer , spacer
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic` , textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
[ width 150 [ width 150
@ -671,8 +615,7 @@ buildUI wenv model = widgetTree
] ]
] ]
, hstack , hstack
[ label "Amount:" `styleBasic` [ label "Amount:" `styleBasic` [width 50]
[width 50, textFont "Bold"]
, spacer , spacer
, numericField_ , numericField_
sendAmount sendAmount
@ -690,14 +633,12 @@ buildUI wenv model = widgetTree
] ]
] ]
, hstack , hstack
[ label "Memo:" `styleBasic` [ label "Memo:" `styleBasic` [width 50]
[width 50, textFont "Bold"]
, spacer , spacer
, textArea sendMemo `styleBasic` , textArea sendMemo `styleBasic`
[width 150, height 40] [width 150, height 40]
] ]
, spacer , spacer
-- Radio button group for privacy level
, box_ , box_
[alignMiddle] [alignMiddle]
(hstack (hstack
@ -757,7 +698,7 @@ buildUI wenv model = widgetTree
box box
(label (fromMaybe "?" $ model ^. modalMsg) `styleBasic` (label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
[textSize 12, textFont "Bold"]) `styleBasic` [textSize 12, textFont "Bold"]) `styleBasic`
[bgColor (white & L.a .~ 0.7)] [bgColor (white & L.a .~ 0.5)]
txOverlay = txOverlay =
case model ^. showTx of case model ^. showTx of
Nothing -> alert CloseTx $ label "N/A" Nothing -> alert CloseTx $ label "N/A"
@ -991,121 +932,6 @@ buildUI wenv model = widgetTree
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline] , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
, filler , filler
] ]
shieldOverlay =
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(label "Shield Zcash" `styleBasic`
[textFont "Bold", textSize 12])
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label
("Shield " <>
displayAmount (model ^. network) (model ^. tBalance) <>
"?") `styleBasic`
[width 50, textFont "Regular"]
, spacer
, box_
[alignMiddle]
(hstack
[ filler
, mainButton "Proceed" SendShield `nodeEnabled`
True
, spacer
, mainButton "Cancel" CloseShield `nodeEnabled`
True
, filler
])
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
deShieldOverlay =
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(label "De-Shield Zcash" `styleBasic`
[textFont "Bold", textSize 12])
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, box_
[]
(vstack
[ hstack
[ label "Total Transparent : " `styleBasic`
[textFont "Bold"]
, label
(displayAmount
(model ^. network)
(model ^. tBalance))
]
, spacer
, hstack
[ label "Total Shielded : " `styleBasic`
[textFont "Bold"]
, label
(displayAmount
(model ^. network)
(model ^. sBalance))
]
, spacer
, hstack
[ label "Amount:" `styleBasic`
[width 50, textFont "Bold"]
, spacer
, numericField_
sendAmount
[ decimals 8
, minValue 0.0
, maxValue
(fromIntegral (model ^. sBalance) /
100000000.0)
, validInput sBalanceValid
, onChange CheckAmount
] `styleBasic`
[ width 150
, styleIf
(not $ model ^. sBalanceValid)
(textColor red)
]
]
])
, spacer
, box_
[alignMiddle]
(hstack
[ filler
, mainButton "Proceed" SendDeShield `nodeEnabled`
True
, spacer
, mainButton "Cancel" CloseDeShield `nodeEnabled`
True
, filler
])
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
notImplemented = NotImplemented notImplemented = NotImplemented
@ -1122,9 +948,9 @@ generateQRCodes config = do
if not (null s) if not (null s)
then return () then return ()
else do else do
generateOneQr pool OrchardPool wAddr generateOneQr pool Orchard wAddr
generateOneQr pool SaplingPool wAddr generateOneQr pool Sapling wAddr
generateOneQr pool TransparentPool wAddr generateOneQr pool Transparent wAddr
generateOneQr :: generateOneQr ::
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO () ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
generateOneQr p zp wAddr = generateOneQr p zp wAddr =
@ -1159,7 +985,7 @@ generateQRCodes config = do
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
dispAddr zp w = dispAddr zp w =
case zp of case zp of
TransparentPool -> Transparent ->
T.append "zcash:" . T.append "zcash:" .
encodeTransparentReceiver encodeTransparentReceiver
(maybe (maybe
@ -1171,12 +997,11 @@ generateQRCodes config = do
(t_rec =<< (t_rec =<<
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
w) w)
SaplingPool -> Sapling ->
T.append "zcash:" <$> T.append "zcash:" <$>
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
OrchardPool -> Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w Sprout -> Nothing
SproutPool -> Nothing
handleEvent :: handleEvent ::
WidgetEnv AppModel AppEvent WidgetEnv AppModel AppEvent
@ -1231,11 +1056,7 @@ handleEvent wenv node model evt =
] ]
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False] ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
ShowSend -> ShowSend -> [Model $ model & openSend .~ True]
[ Model $
model & openSend .~ True & privacyChoice .~ Full & recipientValid .~
False
]
SendTx -> SendTx ->
case currentAccount of case currentAccount of
Nothing -> [Event $ ShowError "No account available", Event CancelSend] Nothing -> [Event $ ShowError "No account available", Event CancelSend]
@ -1250,10 +1071,9 @@ handleEvent wenv node model evt =
(model ^. network) (model ^. network)
(entityKey acc) (entityKey acc)
(zcashWalletLastSync $ entityVal wal) (zcashWalletLastSync $ entityVal wal)
(fromFloatDigits $ model ^. sendAmount) (model ^. sendAmount)
(model ^. sendRecipient) (model ^. sendRecipient)
(model ^. sendMemo) (model ^. sendMemo)
(model ^. privacyChoice)
, Event CancelSend , Event CancelSend
] ]
CancelSend -> CancelSend ->
@ -1295,7 +1115,7 @@ handleEvent wenv node model evt =
Just wAddr -> getUserTx dbPool $ entityKey wAddr Just wAddr -> getUserTx dbPool $ entityKey wAddr
] ]
SwitchQr q -> [Model $ model & qrCodeWidget .~ q] SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool OrchardPool] SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
SwitchAcc i -> SwitchAcc i ->
[ Model $ model & selAcc .~ i [ Model $ model & selAcc .~ i
, Task $ , Task $
@ -1308,14 +1128,12 @@ handleEvent wenv node model evt =
UpdateBalance <$> do UpdateBalance <$> do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
case selectAccount i of case selectAccount i of
Nothing -> return (0, 0, 0, 0) Nothing -> return (0, 0)
Just acc -> do Just acc -> do
b <- getBalance dbPool $ entityKey acc b <- getBalance dbPool $ entityKey acc
u <- getUnconfirmedBalance dbPool $ entityKey acc u <- getUnconfirmedBalance dbPool $ entityKey acc
s <- getShieldedBalance dbPool $ entityKey acc return (b, u)
t <- getTransparentBalance dbPool $ entityKey acc , Event $ SetPool Orchard
return (b, u, s, t)
, Event $ SetPool OrchardPool
] ]
SwitchWal i -> SwitchWal i ->
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0 [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
@ -1326,9 +1144,9 @@ handleEvent wenv node model evt =
Nothing -> return [] Nothing -> return []
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
] ]
UpdateBalance (b, u, s, t) -> UpdateBalance (b, u) ->
[ Model $ [ Model $
model & balance .~ b & sBalance .~ s & tBalance .~ t & unconfBalance .~ model & balance .~ b & unconfBalance .~
(if u == 0 (if u == 0
then Nothing then Nothing
else Just u) else Just u)
@ -1338,15 +1156,14 @@ handleEvent wenv node model evt =
, setClipboardData $ , setClipboardData $
ClipboardText $ ClipboardText $
case model ^. selPool of case model ^. selPool of
OrchardPool -> Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
maybe "None" (getUA . walletAddressUAddress . entityVal) a Sapling ->
SaplingPool ->
fromMaybe "None" $ fromMaybe "None" $
(getSaplingFromUA . (getSaplingFromUA .
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
a a
SproutPool -> "None" Sprout -> "None"
TransparentPool -> Transparent ->
maybe "None" (encodeTransparentReceiver (model ^. network)) $ maybe "None" (encodeTransparentReceiver (model ^. network)) $
t_rec =<< t_rec =<<
(isValidUnifiedAddress . (isValidUnifiedAddress .
@ -1369,7 +1186,7 @@ handleEvent wenv node model evt =
if not (null a) if not (null a)
then [ Model $ model & addresses .~ a then [ Model $ model & addresses .~ a
, Event $ SwitchAddr $ model ^. selAddr , Event $ SwitchAddr $ model ^. selAddr
, Event $ SetPool OrchardPool , Event $ SetPool Orchard
] ]
else [Event $ NewAddress currentAccount] else [Event $ NewAddress currentAccount]
LoadAccs a -> LoadAccs a ->
@ -1378,7 +1195,7 @@ handleEvent wenv node model evt =
else [Event $ NewAccount currentWallet] else [Event $ NewAccount currentWallet]
LoadWallets a -> LoadWallets a ->
if not (null a) if not (null a)
then [ Model $ model & wallets .~ a & modalMsg .~ Nothing then [ Model $ model & wallets .~ a
, Event $ SwitchWal $ model ^. selWallet , Event $ SwitchWal $ model ^. selWallet
] ]
else [Event NewWallet] else [Event NewWallet]
@ -1388,50 +1205,39 @@ handleEvent wenv node model evt =
CloseTxId -> [Model $ model & showId .~ Nothing] CloseTxId -> [Model $ model & showId .~ Nothing]
ShowTx i -> [Model $ model & showTx ?~ i] ShowTx i -> [Model $ model & showTx ?~ i]
TickUp -> TickUp ->
if isNothing (model ^. modalMsg) if (model ^. timer) < 90
then if (model ^. timer) < 90 then [Model $ model & timer .~ (1 + model ^. timer)]
then [Model $ model & timer .~ (1 + model ^. timer)] else if (model ^. barValue) == 1.0
else if (model ^. barValue) == 1.0 then [ Model $ model & timer .~ 0 & barValue .~ 0.0
then [ Model $ , Producer $
model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~ scanZebra
"Downloading blocks..." (c_dbPath $ model ^. configuration)
, Producer $ (c_zebraHost $ model ^. configuration)
runNoLoggingT . (c_zebraPort $ model ^. configuration)
scanZebra (model ^. network)
(c_dbPath $ model ^. configuration) ]
(c_zebraHost $ model ^. configuration) else [Model $ model & timer .~ 0]
(c_zebraPort $ model ^. configuration)
(model ^. network)
]
else [Model $ model & timer .~ 0]
else [Model $ model & timer .~ 0]
TreeSync -> [Model $ model & modalMsg ?~ "Updating commitment trees..."]
StartSync ->
[ Model $ model & modalMsg ?~ "Updating wallet..."
, Task $ do
case currentWallet of
Nothing -> return $ ShowError "No wallet available"
Just cW -> do
runNoLoggingT $ syncWallet (model ^. configuration) cW
pool <-
runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
]
SyncVal i -> SyncVal i ->
if (i + model ^. barValue) >= 0.999 if (i + model ^. barValue) >= 0.999
then [Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing] then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing
, Task $ do
case currentWallet of
Nothing -> return $ ShowError "No wallet available"
Just cW -> do
syncWallet (model ^. configuration) cW
pool <-
runNoLoggingT $
initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
]
else [ Model $ else [ Model $
model & barValue .~ validBarValue (i + model ^. barValue) & model & barValue .~ validBarValue (i + model ^. barValue) &
modalMsg ?~ modalMsg ?~
("Wallet Sync: " <> ("Wallet Sync: " <>
T.pack (printf "%.2f%%" (model ^. barValue * 100))) T.pack (printf "%.2f%%" (model ^. barValue * 100)))
] ]
ResetRecipientValid -> [Model $ model & recipientValid .~ False] CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
CheckRecipient a ->
[ Model $
model & recipientValid .~ isRecipientValidGUI (model ^. privacyChoice) a
]
CheckAmount i -> CheckAmount i ->
[ Model $ [ Model $
model & amountValid .~ model & amountValid .~
@ -1442,7 +1248,7 @@ handleEvent wenv node model evt =
-- | Address Book Events -- | Address Book Events
-- | -- |
CheckValidAddress a -> CheckValidAddress a ->
[Model $ model & abAddressValid .~ isZecAddressValid a] [Model $ model & abAddressValid .~ isRecipientValid a]
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a] CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
ShowAdrBook -> ShowAdrBook ->
if null (model ^. abaddressList) if null (model ^. abaddressList)
@ -1505,13 +1311,6 @@ handleEvent wenv node model evt =
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
] ]
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
ShowShield ->
if model ^. tBalance > 0
then [Model $ model & shieldZec .~ True & menuPopup .~ False]
else [Event $ ShowError "No transparent funds in this account"]
CloseShield -> [Model $ model & shieldZec .~ False]
ShowDeShield -> [Model $ model & deShieldZec .~ True & menuPopup .~ False]
CloseDeShield -> [Model $ model & deShieldZec .~ False]
LoadAbList a -> [Model $ model & abaddressList .~ a] LoadAbList a -> [Model $ model & abaddressList .~ a]
UpdateABDescrip d a -> UpdateABDescrip d a ->
[ Task $ updAddrBookDescrip (model ^. configuration) d a [ Task $ updAddrBookDescrip (model ^. configuration) d a
@ -1524,31 +1323,6 @@ handleEvent wenv node model evt =
abList <- getAdrBook dbPool $ model ^. network abList <- getAdrBook dbPool $ model ^. network
return $ LoadAbList abList return $ LoadAbList abList
] ]
SendDeShield ->
case currentAccount of
Nothing ->
[Event $ ShowError "No account available", Event CloseDeShield]
Just acc ->
[ Producer $
deshieldTransaction
(model ^. configuration)
(model ^. network)
(entityKey acc)
currentAddress
(fromFloatDigits $ model ^. sendAmount)
, Event CloseDeShield
]
SendShield ->
case currentAccount of
Nothing -> [Event $ ShowError "No account available", Event CloseShield]
Just acc ->
[ Producer $
shieldTransaction
(model ^. configuration)
(model ^. network)
(entityKey acc)
, Event CloseShield
]
where where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -1663,57 +1437,26 @@ handleEvent wenv node model evt =
res <- liftIO $ updateAdrsInAdrBook pool d a a res <- liftIO $ updateAdrsInAdrBook pool d a a
return $ ShowMessage "Address Book entry updated!!" return $ ShowMessage "Address Book entry updated!!"
scanZebra :: scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
T.Text
-> T.Text
-> Int
-> ZcashNet
-> (AppEvent -> IO ())
-> NoLoggingT IO ()
scanZebra dbPath zHost zPort net sendMsg = do scanZebra dbPath zHost zPort net sendMsg = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- liftIO $ checkIntegrity dbPath zHost zPort net dbBlock 1 let sb = max dbBlock b
logDebugN $ "dbBlock: " <> T.pack (show dbBlock) confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
logDebugN $ "chkBlock: " <> T.pack (show chkBlock) case confUp of
syncChk <- liftIO $ isSyncing pool Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
if syncChk Right _ -> do
then liftIO $ sendMsg (ShowError "Sync already in progress")
else do
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
rewindWalletData pool sb $ ZcashNetDB net
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then liftIO $ sendMsg (ShowError "Invalid starting block for scan") then sendMsg (ShowError "Invalid starting block for scan")
else do else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList) if not (null bList)
then do then do
let step = (1.0 :: Float) / fromIntegral (length bList) let step = (1.0 :: Float) / fromIntegral (length bList)
_ <- liftIO $ startSync pool mapM_ (processBlock pool step) bList
mapM_ (liftIO . processBlock pool step) bList else sendMsg (SyncVal 1.0)
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
IO
(Either IOError ())
case confUp of
Left _e0 -> do
_ <- liftIO $ completeSync pool Failed
liftIO $
sendMsg
(ShowError "Failed to update unconfirmed transactions")
Right _ -> do
liftIO $ sendMsg TreeSync
_ <- updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
_ <- liftIO $ completeSync pool Successful
logDebugN "Starting wallet sync"
liftIO $ sendMsg StartSync
else liftIO $ sendMsg (SyncVal 1.0)
where where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -1725,9 +1468,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
"getblock" "getblock"
[Data.Aeson.String $ showt bl, jsonNumber 1] [Data.Aeson.String $ showt bl, jsonNumber 1]
case r of case r of
Left e1 -> do Left e1 -> sendMsg (ShowError $ showt e1)
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e1)
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -1737,136 +1478,42 @@ scanZebra dbPath zHost zPort net sendMsg = do
"getblock" "getblock"
[Data.Aeson.String $ showt bl, jsonNumber 0] [Data.Aeson.String $ showt bl, jsonNumber 0]
case r2 of case r2 of
Left e2 -> do Left e2 -> sendMsg (ShowError $ showt e2)
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e2)
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
saveBlock pool $ bl_txs $ addTime blk blockTime
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB net)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
sendMsg (SyncVal step) sendMsg (SyncVal step)
addTime :: BlockResponse -> Int -> BlockResponse
shieldTransaction :: addTime bl t =
Config -> ZcashNet -> ZcashAccountId -> (AppEvent -> IO ()) -> IO () BlockResponse
shieldTransaction config znet accId sendMsg = do (bl_confirmations bl)
sendMsg $ ShowModal "Shielding funds..." (bl_height bl)
let dbPath = c_dbPath config (fromIntegral t)
let zHost = c_zebraHost config (bl_txs bl)
let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath
bl <- getChainTip zHost zPort
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
forM_ res $ \case
Left e -> sendMsg $ ShowError $ T.pack (show e)
Right rawTx -> do
sendMsg $ ShowMsg "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> T.pack (show e1)
Right txId -> sendMsg $ ShowTxId txId
deshieldTransaction ::
Config
-> ZcashNet
-> ZcashAccountId
-> Maybe (Entity WalletAddress)
-> Scientific
-> (AppEvent -> IO ())
-> IO ()
deshieldTransaction config znet accId addR pnote sendMsg = do
case addR of
Nothing -> sendMsg $ ShowError "No address available"
Just addr -> do
sendMsg $ ShowModal "De-shielding funds..."
let dbPath = c_dbPath config
let zHost = c_zebraHost config
let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath
bl <- getChainTip zHost zPort
let tAddrMaybe =
Transparent <$>
((decodeTransparentAddress .
E.encodeUtf8 . encodeTransparentReceiver znet) =<<
(t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal addr)))
case tAddrMaybe of
Nothing -> sendMsg $ ShowError "No transparent address available"
Just tAddr -> do
res <-
runNoLoggingT $
deshieldNotes
pool
zHost
zPort
znet
accId
bl
(ProposedNote (ValidAddressAPI tAddr) pnote Nothing)
case res of
Left e -> sendMsg $ ShowError $ T.pack (show e)
Right rawTx -> do
sendMsg $ ShowModal "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1
Right txId -> sendMsg $ ShowTxId txId
sendTransaction :: sendTransaction ::
Config Config
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Scientific -> Float
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy
-> (AppEvent -> IO ()) -> (AppEvent -> IO ())
-> IO () -> IO ()
sendTransaction config znet accId bl amt ua memo policy sendMsg = do sendTransaction config znet accId bl amt ua memo sendMsg = do
sendMsg $ ShowModal "Preparing transaction..." sendMsg $ ShowModal "Preparing transaction..."
case parseAddress (E.encodeUtf8 ua) of case parseAddress ua znet of
Nothing -> sendMsg $ ShowError "Incorrect address" Nothing -> sendMsg $ ShowError "Incorrect address"
Just addr -> do Just outUA -> do
let dbPath = c_dbPath config let dbPath = c_dbPath config
let zHost = c_zebraHost config let zHost = c_zebraHost config
let zPort = c_zebraPort config let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
res <- res <-
runNoLoggingT $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTx pool zHost zPort znet accId bl amt outUA memo
pool
zHost
zPort
znet
accId
bl
[ ProposedNote
(ValidAddressAPI addr)
amt
(if memo == ""
then Nothing
else Just memo)
]
policy
case res of case res of
Left e -> sendMsg $ ShowError $ T.pack $ show e Left e -> sendMsg $ ShowError $ T.pack $ show e
Right rawTx -> do Right rawTx -> do
@ -1913,7 +1560,6 @@ runZenithGUI config = do
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
x <- initDb dbFilePath x <- initDb dbFilePath
_ <- upgradeQrTable pool
case x of case x of
Left e2 -> throwIO $ userError e2 Left e2 -> throwIO $ userError e2
Right x' -> do Right x' -> do
@ -1936,8 +1582,7 @@ runZenithGUI config = do
else return [] else return []
qr <- qr <-
if not (null addrList) if not (null addrList)
then getQrCode pool OrchardPool $ then getQrCode pool Orchard $ entityKey $ head addrList
entityKey $ head addrList
else return Nothing else return Nothing
bal <- bal <-
if not (null accList) if not (null accList)
@ -1948,14 +1593,6 @@ runZenithGUI config = do
then getUnconfirmedBalance pool $ entityKey $ head accList then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0 else return 0
abList <- getAdrBook pool (zgb_net chainInfo) abList <- getAdrBook pool (zgb_net chainInfo)
shieldBal <-
if not (null accList)
then getShieldedBalance pool $ entityKey $ head accList
else return 0
transBal <-
if not (null accList)
then getTransparentBalance pool $ entityKey $ head accList
else return 0
let model = let model =
AppModel AppModel
config config
@ -1974,7 +1611,7 @@ runZenithGUI config = do
(if unconfBal == 0 (if unconfBal == 0
then Nothing then Nothing
else Just unconfBal) else Just unconfBal)
OrchardPool Orchard
qr qr
False False
False False
@ -2012,13 +1649,6 @@ runZenithGUI config = do
Nothing Nothing
False False
False False
Full
False
False
transBal
False
shieldBal
False
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left _e -> print "Zebra not available" Left _e -> print "Zebra not available"
where where

View file

@ -8,28 +8,21 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
module Zenith.RPC where module Zenith.RPC where
import Control.Concurrent (forkIO)
import Control.Exception (try) import Control.Exception (try)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.HexString as H
import Data.Int import Data.Int
import Data.Scientific (floatingOrInteger) import Data.Scientific (floatingOrInteger)
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 (getCurrentTime)
import qualified Data.UUID as U import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V import qualified Data.Vector as V
import Database.Esqueleto.Experimental import Database.Esqueleto.Experimental
( ConnectionPool ( entityKey
, entityKey
, entityVal , entityVal
, fromSqlKey , fromSqlKey
, toSqlKey , toSqlKey
@ -38,73 +31,43 @@ import Servant
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress) import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
( BlockResponse(..) import Zenith.Core (createCustomWalletAddress, createZcashAccount)
, RpcError(..)
, Scope(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
( checkBlockChain
, createCustomWalletAddress
, createZcashAccount
, prepareTxV2
, syncWallet
, updateCommitmentTrees
)
import Zenith.DB import Zenith.DB
( Operation(..) ( Operation(..)
, ZcashAccount(..) , ZcashAccount(..)
, ZcashBlock(..)
, ZcashWallet(..) , ZcashWallet(..)
, completeSync
, finalizeOperation
, findNotesByAddress , findNotesByAddress
, getAccountById , getAccountById
, getAccounts , getAccounts
, getAddressById , getAddressById
, getAddresses , getAddresses
, getExternalAddresses , getExternalAddresses
, getLastSyncBlock
, getMaxAccount , getMaxAccount
, getMaxAddress , getMaxAddress
, getMaxBlock
, getMinBirthdayHeight
, getOperation , getOperation
, getPoolBalance , getPoolBalance
, getUnconfPoolBalance , getUnconfPoolBalance
, getWalletNotes , getWalletNotes
, getWallets , getWallets
, initPool , initPool
, isSyncing
, rewindWalletData
, saveAccount , saveAccount
, saveAddress , saveAddress
, saveBlock
, saveOperation
, saveWallet , saveWallet
, startSync
, toZcashAccountAPI , toZcashAccountAPI
, toZcashAddressAPI , toZcashAddressAPI
, toZcashWalletAPI , toZcashWalletAPI
, walletExists , walletExists
) )
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types import Zenith.Types
( AccountBalance(..) ( AccountBalance(..)
, Config(..) , Config(..)
, HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZcashNoteAPI(..) , ZcashNoteAPI(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..) , ZenithUuid(..)
) )
import Zenith.Utils (jsonNumber) import Zenith.Utils (jsonNumber)
@ -120,7 +83,6 @@ data ZenithMethod
| GetNewAccount | GetNewAccount
| GetNewAddress | GetNewAddress
| GetOperationStatus | GetOperationStatus
| SendMany
| UnknownMethod | UnknownMethod
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -135,7 +97,6 @@ instance ToJSON ZenithMethod where
toJSON GetNewAccount = Data.Aeson.String "getnewaccount" toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
toJSON GetNewAddress = Data.Aeson.String "getnewaddress" toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus" toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
toJSON SendMany = Data.Aeson.String "sendmany"
toJSON UnknownMethod = Data.Aeson.Null toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where instance FromJSON ZenithMethod where
@ -151,7 +112,6 @@ instance FromJSON ZenithMethod where
"getnewaccount" -> pure GetNewAccount "getnewaccount" -> pure GetNewAccount
"getnewaddress" -> pure GetNewAddress "getnewaddress" -> pure GetNewAddress
"getoperationstatus" -> pure GetOperationStatus "getoperationstatus" -> pure GetOperationStatus
"sendmany" -> pure SendMany
_ -> pure UnknownMethod _ -> pure UnknownMethod
data ZenithParams data ZenithParams
@ -165,7 +125,6 @@ data ZenithParams
| NameIdParams !T.Text !Int | NameIdParams !T.Text !Int
| NewAddrParams !Int !T.Text !Bool !Bool | NewAddrParams !Int !T.Text !Bool !Bool
| OpParams !ZenithUuid | OpParams !ZenithUuid
| SendParams !Int ![ProposedNote] !PrivacyPolicy
| TestParams !T.Text | TestParams !T.Text
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -189,8 +148,6 @@ instance ToJSON ZenithParams where
[Data.Aeson.String "ExcludeTransparent" | t] [Data.Aeson.String "ExcludeTransparent" | t]
toJSON (OpParams i) = toJSON (OpParams i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i] Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
toJSON (SendParams i ns p) =
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
data ZenithResponse data ZenithResponse
= InfoResponse !T.Text !ZenithInfo = InfoResponse !T.Text !ZenithInfo
@ -202,7 +159,6 @@ data ZenithResponse
| NewItemResponse !T.Text !Int64 | NewItemResponse !T.Text !Int64
| NewAddrResponse !T.Text !ZcashAddressAPI | NewAddrResponse !T.Text !ZcashAddressAPI
| OpResponse !T.Text !Operation | OpResponse !T.Text !Operation
| SendResponse !T.Text !U.UUID
| ErrorResponse !T.Text !Double !T.Text | ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -223,7 +179,6 @@ instance ToJSON ZenithResponse where
toJSON (NewItemResponse i ix) = packRpcResponse i ix toJSON (NewItemResponse i ix) = packRpcResponse i ix
toJSON (NewAddrResponse i a) = packRpcResponse i a toJSON (NewAddrResponse i a) = packRpcResponse i a
toJSON (OpResponse i u) = packRpcResponse i u toJSON (OpResponse i u) = packRpcResponse i u
toJSON (SendResponse i o) = packRpcResponse i o
instance FromJSON ZenithResponse where instance FromJSON ZenithResponse where
parseJSON = parseJSON =
@ -303,10 +258,6 @@ instance FromJSON ZenithResponse where
case floatingOrInteger k of case floatingOrInteger k of
Left _e -> fail "Unknown value" Left _e -> fail "Unknown value"
Right k' -> pure $ NewItemResponse i k' Right k' -> pure $ NewItemResponse i k'
String s -> do
case U.fromText s of
Nothing -> fail "Unknown value"
Just u -> pure $ SendResponse i u
_anyOther -> fail "Malformed JSON" _anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1) Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
@ -465,30 +416,6 @@ instance FromJSON RpcCall where
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
else pure $ RpcCall v i GetOperationStatus BadParams else pure $ RpcCall v i GetOperationStatus BadParams
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams _anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
SendMany -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a >= 2
then do
acc <- parseJSON $ a V.! 0
x <- parseJSON $ a V.! 1
case x of
String _ -> do
x' <- parseJSON $ a V.! 1
y <- parseJSON $ a V.! 2
if not (null y)
then pure $ RpcCall v i SendMany (SendParams acc y x')
else pure $ RpcCall v i SendMany BadParams
Array _ -> do
x' <- parseJSON $ a V.! 1
if not (null x')
then pure $
RpcCall v i SendMany (SendParams acc x' Full)
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
type ZenithRPC type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@ -646,35 +573,27 @@ zenithServer state = getinfo :<|> handleRPC
case parameters req of case parameters req of
NameParams t -> do NameParams t -> do
let dbPath = w_dbPath state let dbPath = w_dbPath state
sP <- liftIO generateWalletSeedPhrase
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool r <-
if syncChk liftIO $
then return $ saveWallet pool $
ErrorResponse ZcashWallet
(callId req) t
(-32012) (ZcashNetDB $ w_network state)
"The Zenith server is syncing, please try again later." (PhraseDB sP)
else do (w_startBlock state)
sP <- liftIO generateWalletSeedPhrase 0
r <- case r of
liftIO $ Nothing ->
saveWallet pool $ return $
ZcashWallet ErrorResponse
t (callId req)
(ZcashNetDB $ w_network state) (-32007)
(PhraseDB sP) "Entity with that name already exists."
(w_startBlock state) Just r' ->
0 return $
case r of NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just r' ->
return $
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAccount -> GetNewAccount ->
@ -682,45 +601,34 @@ zenithServer state = getinfo :<|> handleRPC
NameIdParams t i -> do NameIdParams t i -> do
let dbPath = w_dbPath state let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool w <- liftIO $ walletExists pool i
if syncChk case w of
then return $ Just w' -> do
ErrorResponse aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
(callId req) nAcc <-
(-32012) liftIO
"The Zenith server is syncing, please try again later." (try $ createZcashAccount t (aIdx + 1) w' :: IO
else do (Either IOError ZcashAccount))
w <- liftIO $ walletExists pool i case nAcc of
case w of Left e ->
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 $ return $
ErrorResponse ErrorResponse (callId req) (-32010) $ T.pack $ show e
(callId req) Right nAcc' -> do
(-32008) r <- liftIO $ saveAccount pool nAcc'
"Wallet does not exist." 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 -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAddress -> GetNewAddress ->
@ -729,49 +637,35 @@ zenithServer state = getinfo :<|> handleRPC
let dbPath = w_dbPath state let dbPath = w_dbPath state
let net = w_network state let net = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
if syncChk case acc of
then return $ Just acc' -> do
ErrorResponse maxAddr <-
(callId req) liftIO $ getMaxAddress pool (entityKey acc') External
(-32012) newAddr <-
"The Zenith server is syncing, please try again later." liftIO $
else do createCustomWalletAddress
acc <- n
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i (maxAddr + 1)
case acc of net
Just acc' -> do External
maxAddr <- acc'
liftIO $ getMaxAddress pool (entityKey acc') External s
newAddr <- t
liftIO $ dbAddr <- liftIO $ saveAddress pool newAddr
createCustomWalletAddress case dbAddr of
n Just nAddr -> do
(maxAddr + 1) return $
net NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
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 -> Nothing ->
return $ return $
ErrorResponse ErrorResponse
(callId req) (callId req)
(-32006) (-32007)
"Account does not exist." "Entity with that name already exists."
Nothing ->
return $
ErrorResponse (callId req) (-32006) "Account does not exist."
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetOperationStatus -> GetOperationStatus ->
@ -788,89 +682,6 @@ zenithServer state = getinfo :<|> handleRPC
ErrorResponse (callId req) (-32009) "Operation ID not found" ErrorResponse (callId req) (-32009) "Operation ID not found"
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
SendMany ->
case parameters req of
SendParams a ns p -> do
let dbPath = w_dbPath state
let zHost = w_host state
let zPort = w_port state
let znet = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
opid <- liftIO nextRandom
startTime <- liftIO getCurrentTime
opkey <-
liftIO $
saveOperation pool $
Operation
(ZenithUuid opid)
startTime
Nothing
Processing
Nothing
case opkey of
Nothing ->
return $
ErrorResponse (callId req) (-32010) "Internal Error"
Just opkey' -> do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
case acc of
Just acc' -> do
bl <-
liftIO $
getLastSyncBlock
pool
(zcashAccountWalletId $ entityVal acc')
_ <-
liftIO $
forkIO $ do
res <-
liftIO $
runNoLoggingT $
prepareTxV2
pool
zHost
zPort
znet
(entityKey acc')
bl
ns
p
case res of
Left e ->
finalizeOperation pool opkey' Failed $
T.pack $ show e
Right rawTx -> do
zebraRes <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ H.toText rawTx]
case zebraRes of
Left e1 ->
finalizeOperation pool opkey' Failed $
T.pack $ show e1
Right txId ->
finalizeOperation pool opkey' Successful $
"Tx ID: " <> H.toText txId
return $ SendResponse (callId req) opid
Nothing ->
return $
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
authenticate :: Config -> BasicAuthCheck Bool authenticate :: Config -> BasicAuthCheck Bool
authenticate config = BasicAuthCheck check authenticate config = BasicAuthCheck check
@ -883,71 +694,3 @@ authenticate config = BasicAuthCheck check
packRpcResponse :: ToJSON a => T.Text -> a -> Value packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x = packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x] object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
scanZebra dbPath zHost zPort net = do
bStatus <- checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool $ ZcashNetDB net
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool
unless syncChk $ do
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do
_ <- startSync pool
mapM_ (processBlock pool) bList
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> do
_ <- completeSync pool Failed
return ()
Right _ -> do
wals <- getWallets pool net
_ <-
runNoLoggingT $
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
runNoLoggingT $
mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals
_ <- completeSync pool Successful
return ()
where
processBlock :: ConnectionPool -> Int -> IO ()
processBlock pool bl = do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
case r of
Left _ -> completeSync pool Failed
Right blk -> do
r2 <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
case r2 of
Left _ -> completeSync pool Failed
Right hb -> do
let blockTime = getBlockTime hb
bi <-
saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB net)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk

View file

@ -6,13 +6,7 @@ import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (when) 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)
( NoLoggingT
, logErrorN
, logInfoN
, runNoLoggingT
, runStderrLoggingT
)
import Data.Aeson import Data.Aeson
import Data.HexString import Data.HexString
import qualified Data.Text as T import qualified Data.Text as T
@ -31,33 +25,21 @@ import ZcashHaskell.Types
, fromRawTBundle , fromRawTBundle
) )
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees) import Zenith.Core (checkBlockChain, syncWallet)
import Zenith.DB import Zenith.DB
( ZcashBlock(..) ( clearWalletData
, ZcashBlockId
, clearWalletData
, clearWalletTransactions , clearWalletTransactions
, completeSync
, getBlock
, getMaxBlock , getMaxBlock
, getMinBirthdayHeight , getMinBirthdayHeight
, getUnconfirmedBlocks , getUnconfirmedBlocks
, getWallets , getWallets
, initDb , initDb
, initPool , initPool
, saveBlock
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, startSync
, updateWalletSync , updateWalletSync
, upgradeQrTable
)
import Zenith.Types
( Config(..)
, HexStringDB(..)
, ZcashNetDB(..)
, ZenithStatus(..)
) )
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
@ -75,15 +57,12 @@ rescanZebra host port dbFilePath = do
Right bStatus -> do Right bStatus -> do
let znet = ZcashNetDB $ zgb_net bStatus let znet = ZcashNetDB $ zgb_net bStatus
pool1 <- runNoLoggingT $ initPool dbFilePath pool1 <- runNoLoggingT $ initPool dbFilePath
{-pool2 <- runNoLoggingT $ initPool dbFilePath-} pool2 <- runNoLoggingT $ initPool dbFilePath
{-pool3 <- runNoLoggingT $ initPool dbFilePath-} pool3 <- runNoLoggingT $ initPool dbFilePath
_ <- initDb dbFilePath
upgradeQrTable pool1
clearWalletTransactions pool1 clearWalletTransactions pool1
clearWalletData pool1 clearWalletData pool1
_ <- startSync pool1
dbBlock <- getMaxBlock pool1 znet dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight 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"
@ -107,8 +86,6 @@ rescanZebra host port dbFilePath = do
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-} {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-} {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..." print "Please wait..."
_ <- completeSync pool1 Successful
_ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
print "Rescan complete" print "Rescan complete"
-- | Function to process a raw block and extract the transaction information -- | Function to process a raw block and extract the transaction information
@ -129,9 +106,7 @@ processBlock host port pool pg net b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1] [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of case r of
Left e -> do Left e -> liftIO $ throwIO $ userError e
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -141,31 +116,31 @@ processBlock host port pool pg net b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0] [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
case r2 of case r2 of
Left e2 -> do Left e2 -> liftIO $ throwIO $ userError e2
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- mapM_ (processTx host port blockTime pool net) $
saveBlock pool $ bl_txs $ addTime blk blockTime
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
net
mapM_ (processTx host port bi pool) $ bl_txs blk
liftIO $ tick pg liftIO $ tick pg
where
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
-- | Function to process a raw transaction -- | Function to process a raw transaction
processTx :: processTx ::
T.Text -- ^ Host name for `zebrad` T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> ZcashBlockId -- ^ Block ID -> Int -- ^ Block time
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> ZcashNetDB -- ^ the network
-> HexString -- ^ transaction id -> HexString -- ^ transaction id
-> IO () -> IO ()
processTx host port bt pool t = do processTx host port bt pool net t = do
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
@ -174,16 +149,14 @@ processTx host port bt pool t = do
"getrawtransaction" "getrawtransaction"
[Data.Aeson.String $ toText t, jsonNumber 1] [Data.Aeson.String $ toText t, jsonNumber 1]
case r of case r of
Left e -> do Left e -> liftIO $ throwIO $ userError e
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right rawTx -> do Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return () Nothing -> return ()
Just rzt -> do Just rzt -> do
_ <- _ <-
runNoLoggingT $ runNoLoggingT $
saveTransaction pool bt $ saveTransaction pool bt net $
Transaction Transaction
t t
(ztr_blockheight rawTx) (ztr_blockheight rawTx)
@ -230,7 +203,6 @@ clearSync config = do
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
x <- initDb dbPath x <- initDb dbPath
_ <- upgradeQrTable pool
case x of case x of
Left e2 -> throwIO $ userError e2 Left e2 -> throwIO $ userError e2
Right x' -> do Right x' -> do
@ -239,36 +211,5 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runNoLoggingT $ mapM (syncWallet config) w' r <- mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r
-- | Detect chain re-orgs
checkIntegrity ::
T.Text -- ^ Database path
-> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port
-> ZcashNet -- ^ the network to scan
-> Int -- ^ The block to start the check
-> Int -- ^ depth
-> IO Int
checkIntegrity dbP zHost zPort znet b d =
if b < 1
then return 1
else do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> do
pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b $ ZcashNetDB znet
case dbBlk of
Nothing -> return 1
Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)

View file

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

View file

@ -17,30 +17,19 @@ import qualified Data.ByteString.Char8 as C
import Data.HexString import Data.HexString
import Data.Int (Int64) import Data.Int (Int64)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Scientific (Scientific)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U import qualified Data.UUID as U
import Database.Persist.TH import Database.Persist.TH
import GHC.Generics import GHC.Generics
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
import ZcashHaskell.Sapling (encodeSaplingAddress)
import ZcashHaskell.Transparent
( encodeExchangeAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
( ExchangeAddress(..) ( OrchardSpendingKey(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, Rseed(..) , Rseed(..)
, SaplingAddress(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, TransparentAddress(..)
, TransparentSpendingKey , TransparentSpendingKey
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
@ -115,10 +104,10 @@ data Config = Config
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)
data ZcashPool data ZcashPool
= TransparentPool = Transparent
| SproutPool | Sprout
| SaplingPool | Sapling
| OrchardPool | Orchard
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
derivePersistField "ZcashPool" derivePersistField "ZcashPool"
@ -126,18 +115,18 @@ derivePersistField "ZcashPool"
instance ToJSON ZcashPool where instance ToJSON ZcashPool where
toJSON zp = toJSON zp =
case zp of case zp of
TransparentPool -> Data.Aeson.String "p2pkh" Transparent -> Data.Aeson.String "p2pkh"
SproutPool -> Data.Aeson.String "sprout" Sprout -> Data.Aeson.String "sprout"
SaplingPool -> Data.Aeson.String "sapling" Sapling -> Data.Aeson.String "sapling"
OrchardPool -> Data.Aeson.String "orchard" Orchard -> Data.Aeson.String "orchard"
instance FromJSON ZcashPool where instance FromJSON ZcashPool where
parseJSON = parseJSON =
withText "ZcashPool" $ \case withText "ZcashPool" $ \case
"p2pkh" -> return TransparentPool "p2pkh" -> return Transparent
"sprout" -> return SproutPool "sprout" -> return Sprout
"sapling" -> return SaplingPool "sapling" -> return Sapling
"orchard" -> return OrchardPool "orchard" -> return Orchard
_ -> fail "Not a known Zcash pool" _ -> fail "Not a known Zcash pool"
newtype ZenithUuid = ZenithUuid newtype ZenithUuid = ZenithUuid
@ -210,64 +199,13 @@ $(deriveJSON defaultOptions ''ZenithStatus)
derivePersistField "ZenithStatus" derivePersistField "ZenithStatus"
data PrivacyPolicy data PrivacyPolicy
= None = Full
| Low
| Medium | Medium
| Full | Low
deriving (Eq, Show, Read, Ord) | None
$(deriveJSON defaultOptions ''PrivacyPolicy) $(deriveJSON defaultOptions ''PrivacyPolicy)
newtype ValidAddressAPI = ValidAddressAPI
{ getVA :: ValidAddress
} deriving newtype (Eq, Show)
instance ToJSON ValidAddressAPI where
toJSON (ValidAddressAPI va) =
case va of
Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
Sapling sa ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeSaplingAddress (net_type sa) (sa_receiver sa))
Transparent ta ->
Data.Aeson.String $
encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
Exchange ea ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeExchangeAddress (ex_network ea) (ex_address ea))
data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI
, pn_amt :: !Scientific
, pn_memo :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
instance FromJSON ProposedNote where
parseJSON =
withObject "ProposedNote" $ \obj -> do
a <- obj .: "address"
n <- obj .: "amount"
m <- obj .:? "memo"
case parseAddress (E.encodeUtf8 a) of
Nothing -> fail "Invalid address"
Just a' ->
if n > 0 && n < 21000000
then pure $ ProposedNote (ValidAddressAPI a') n m
else fail "Invalid amount"
instance ToJSON ProposedNote where
toJSON (ProposedNote a n m) =
object ["address" .= a, "amount" .= n, "memo" .= m]
data ShieldDeshieldOp
= Shield
| Deshield
deriving (Eq, Show, Read, Ord)
-- ** `zebrad` -- ** `zebrad`
-- | Type for modeling the tree state response -- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo data ZebraTreeInfo = ZebraTreeInfo
@ -359,8 +297,7 @@ instance FromJSON AddressGroup where
Nothing -> return [] Nothing -> return []
Just x -> do Just x -> do
x' <- x .:? "addresses" x' <- x .:? "addresses"
return $ return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
processSapling k s2 = processSapling k s2 =
case k of case k of
Nothing -> return [] Nothing -> return []
@ -368,7 +305,7 @@ instance FromJSON AddressGroup where
where processOneSapling sx = where processOneSapling sx =
withObject "Sapling" $ \oS -> do withObject "Sapling" $ \oS -> do
oS' <- oS .: "addresses" oS' <- oS .: "addresses"
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS' return $ map (ZcashAddress sx [Sapling] Nothing) oS'
processUnified u = processUnified u =
case u of case u of
Nothing -> return [] Nothing -> return []

View file

@ -3,38 +3,30 @@
module Zenith.Utils where module Zenith.Utils where
import Data.Aeson import Data.Aeson
import Data.Char (isAlphaNum, isSpace)
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Ord (clamp) import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific) import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Char (isAlphaNum, isSpace)
import System.Directory import System.Directory
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
import ZcashHaskell.Orchard import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
( encodeUnifiedAddress
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeExchangeAddress ( decodeExchangeAddress
, decodeTransparentAddress , decodeTransparentAddress
) )
import ZcashHaskell.Types import ZcashHaskell.Types
( ExchangeAddress(..) ( SaplingAddress(..)
, SaplingAddress(..)
, TransparentAddress(..) , TransparentAddress(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Types import Zenith.Types
( AddressGroup(..) ( AddressGroup(..)
, PrivacyPolicy(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
@ -79,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
-- | Helper function to validate potential Zcash addresses -- | Helper function to validate potential Zcash addresses
validateAddress :: T.Text -> Maybe ZcashPool validateAddress :: T.Text -> Maybe ZcashPool
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk) validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
| tReg = Just TransparentPool | tReg = Just Transparent
| sReg && chkS = Just SaplingPool | sReg && chkS = Just Sapling
| uReg && chk = Just OrchardPool | uReg && chk = Just Orchard
| otherwise = Nothing | otherwise = Nothing
where where
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@ -118,7 +110,7 @@ validBarValue :: Float -> Float
validBarValue = clamp (0, 1) validBarValue = clamp (0, 1)
isRecipientValid :: T.Text -> Bool isRecipientValid :: T.Text -> Bool
isRecipientValid a = do isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True Just _a1 -> True
Nothing -> Nothing ->
@ -130,80 +122,8 @@ isRecipientValid a = do
Just _a4 -> True Just _a4 -> True
Nothing -> False) Nothing -> False)
isUnifiedAddressValid :: T.Text -> Bool parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
isUnifiedAddressValid ua = parseAddress a znet =
case isValidUnifiedAddress (E.encodeUtf8 ua) of
Just _a1 -> True
Nothing -> False
isSaplingAddressValid :: T.Text -> Bool
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
isTransparentAddressValid :: T.Text -> Bool
isTransparentAddressValid ta =
case decodeTransparentAddress (E.encodeUtf8 ta) of
Just _a3 -> True
Nothing -> False
isExchangeAddressValid :: T.Text -> Bool
isExchangeAddressValid xa =
case decodeExchangeAddress (E.encodeUtf8 xa) of
Just _a4 -> True
Nothing -> False
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
isRecipientValidGUI p a = do
let adr = parseAddress (E.encodeUtf8 a)
case p of
Full ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Medium ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Low ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
Transparent ta -> True
_ -> False
Nothing -> False
None ->
case adr of
Just a ->
case a of
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
isZecAddressValid :: T.Text -> Bool
isZecAddressValid a = do
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
Just _a4 -> True
Nothing -> False)
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
parseAddressUA a znet =
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> Just a1 Just a1 -> Just a1
Nothing -> Nothing ->
@ -217,16 +137,16 @@ parseAddressUA a znet =
Nothing -> Nothing Nothing -> Nothing
isValidContent :: String -> Bool isValidContent :: String -> Bool
isValidContent [] = False -- an empty string is invalid isValidContent [] = False -- an empty string is invalid
isValidContent (x:xs) isValidContent (x:xs)
| not (isAlphaNum x) = False -- string must start with an alphanumeric character | not (isAlphaNum x ) = False -- string must start with an alphanumeric character
| otherwise = allValidChars xs -- process the rest of the string | otherwise = allValidChars xs -- process the rest of the string
where where
allValidChars :: String -> Bool allValidChars :: String -> Bool
allValidChars [] = True -- if we got here, string is valid allValidChars [] = True -- if we got here, string is valid
allValidChars (y:ys) allValidChars (y:ys)
| isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
| otherwise = False -- found an invalid character, return false | otherwise = False -- found an invalid character, return false
isValidString :: T.Text -> Bool isValidString :: T.Text -> Bool
isValidString c = do isValidString c = do
@ -235,16 +155,10 @@ isValidString c = do
padWithZero :: Int -> String -> String padWithZero :: Int -> String -> String
padWithZero n s padWithZero n s
| (length s) >= n = s | (length s) >= n = s
| otherwise = padWithZero n ("0" ++ s) | otherwise = padWithZero n ("0" ++ s)
isEmpty :: [a] -> Bool isEmpty :: [a] -> Bool
isEmpty [] = True isEmpty [] = True
isEmpty _ = False isEmpty _ = False
getChainTip :: T.Text -> Int -> IO Int
getChainTip zHost zPort = do
r <- makeZebraCall zHost zPort "getblockcount" []
case r of
Left e1 -> pure 0
Right i -> pure i

View file

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

View file

@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.Configurator import Data.Configurator
import Data.Maybe (fromJust, 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.Time.Clock (getCurrentTime) import Data.Time.Clock (getCurrentTime)
@ -18,7 +18,7 @@ import Servant
import System.Directory import System.Directory
import Test.HUnit hiding (State) import Test.HUnit hiding (State)
import Test.Hspec import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Types import ZcashHaskell.Types
( ZcashNet(..) ( ZcashNet(..)
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
@ -39,9 +39,6 @@ import Zenith.RPC
) )
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
@ -575,107 +572,6 @@ main = do
Left e -> assertFailure e Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32009) Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
Right _ -> assertFailure "unexpected response" Right _ -> assertFailure "unexpected response"
describe "Send tx" $ do
describe "sendmany" $ do
it "bad credentials" $ do
res <-
makeZenithCall
"127.0.0.1"
nodePort
"baduser"
"idontknow"
SendMany
BlankParams
res `shouldBe` Left "Invalid credentials"
describe "correct credentials" $ do
it "invalid account" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
17
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
0.005
(Just "A cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
it "valid account, empty notes" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams 1 [] Full)
case res of
Left e -> assertFailure e
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
it "valid account, single output" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
1
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
5.0
(Just "A cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (SendResponse i o) -> o `shouldNotBe` U.nil
it "valid account, multiple outputs" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
let uaRead2 =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
res <-
makeZenithCall
"127.0.0.1"
nodePort
nodeUser
nodePwd
SendMany
(SendParams
1
[ ProposedNote
(ValidAddressAPI $ fromJust uaRead)
5.0
(Just "A cool memo")
, ProposedNote
(ValidAddressAPI $ fromJust uaRead2)
1.0
(Just "Not so cool memo")
]
Full)
case res of
Left e -> assertFailure e
Right (SendResponse i o) -> o `shouldNotBe` U.nil
startAPI :: Config -> IO () startAPI :: Config -> IO ()
startAPI config = do startAPI config = do

File diff suppressed because it is too large Load diff

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

View file

@ -132,7 +132,6 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" } { "$ref": "#/components/errors/DuplicateName" }
] ]
}, },
@ -229,7 +228,6 @@
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/DuplicateName" }, { "$ref": "#/components/errors/DuplicateName" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidWallet" } { "$ref": "#/components/errors/InvalidWallet" }
] ]
}, },
@ -446,7 +444,6 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/InvalidAccount" }, { "$ref": "#/components/errors/InvalidAccount" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" } { "$ref": "#/components/errors/DuplicateName" }
] ]
}, },
@ -596,11 +593,10 @@
{ {
"name": "sendmany", "name": "sendmany",
"summary": "Send transaction(s)", "summary": "Send transaction(s)",
"description": "Send one transaction by specifying the source account, the privacy policy (optional, default 'Full') and an array of proposed outputs. Each output needs a recipient address, an amount and an optional shielded memo.", "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": [], "tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
"params": [ "params": [
{ "$ref": "#/components/contentDescriptors/AccountId"}, { "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
{ "$ref": "#/components/contentDescriptors/TxRequestArray"} { "$ref": "#/components/contentDescriptors/TxRequestArray"}
], ],
"paramStructure": "by-position", "paramStructure": "by-position",
@ -614,19 +610,14 @@
"examples": [ "examples": [
{ {
"name": "Send a transaction", "name": "Send a transaction",
"summary": "Send a transaction", "summary": "Send one transaction",
"description": "Send a transaction with one output", "description": "Send a single transaction",
"params": [ "params": [
{ {
"name": "Account index", "name": "Account index",
"summary": "The index for the account to use", "summary": "The index for the account to use",
"value": "1" "value": "1"
}, },
{
"name": "Privacy Policy",
"summary": "The selected privacy policy",
"value": "Full"
},
{ {
"name": "Transaction request", "name": "Transaction request",
"summary": "The transaction to attempt", "summary": "The transaction to attempt",
@ -649,7 +640,7 @@
], ],
"errors": [ "errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }, { "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" }, { "$ref": "#/components/errors/InvalidRecipient" },
{ "$ref": "#/components/errors/InvalidAccount" } { "$ref": "#/components/errors/InvalidAccount" }
] ]
}, },
@ -745,16 +736,6 @@
"type": "array", "type": "array",
"items": { "$ref": "#/components/schemas/TxRequest"} "items": { "$ref": "#/components/schemas/TxRequest"}
} }
},
"PrivacyPolicy": {
"name": "Privacy Policy",
"summary": "The chosen privacy policy to use for the transaction",
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
"required": false,
"schema": {
"type": "string",
"enum": ["None", "Low", "Medium", "Full"]
}
} }
}, },
"schemas": { "schemas": {
@ -833,7 +814,8 @@
"properties": { "properties": {
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" }, "address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
"amount": { "type": "number", "description": "The amount to send in ZEC"}, "amount": { "type": "number", "description": "The amount to send in ZEC"},
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"} "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."}
} }
} }
}, },
@ -890,10 +872,6 @@
"InvalidRecipient": { "InvalidRecipient": {
"code": -32011, "code": -32011,
"message": "The provided recipient address is not valid." "message": "The provided recipient address is not valid."
},
"ZenithBusy": {
"code": -32012,
"message": "The Zenith server is syncing, please try again later."
} }
} }
} }

View file

@ -36,7 +36,6 @@ library
Zenith.Zcashd Zenith.Zcashd
Zenith.Scanner Zenith.Scanner
Zenith.RPC Zenith.RPC
Zenith.Tree
hs-source-dirs: hs-source-dirs:
src src
build-depends: build-depends:
@ -50,7 +49,6 @@ library
, base >=4.12 && <5 , base >=4.12 && <5
, base64-bytestring , base64-bytestring
, binary , binary
, borsh
, brick , brick
, bytestring , bytestring
, configurator , configurator
@ -60,7 +58,6 @@ library
, exceptions , exceptions
, filepath , filepath
, ghc , ghc
, generics-sop
, haskoin-core , haskoin-core
, hexstring , hexstring
, http-client , http-client
@ -127,12 +124,9 @@ executable zenithserver
build-depends: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, configurator , configurator
, monad-logger
, wai-extra , wai-extra
, warp , warp
, servant-server , servant-server
, text
, unix
, zcash-haskell , zcash-haskell
, zenith , zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
@ -147,11 +141,8 @@ test-suite zenith-tests
build-depends: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, aeson
, configurator , configurator
, monad-logger , monad-logger
, borsh
, aeson
, data-default , data-default
, sort , sort
, text , text