Compare commits
81 commits
master
...
zrpc-docke
Author | SHA1 | Date | |
---|---|---|---|
f5f1eddc59 | |||
7189ddcb2a | |||
4a874897cf | |||
befc3e46cc | |||
eaa596fdac | |||
a2be940648 | |||
f4f149d6a2 | |||
4aad9cb57f | |||
c9a42572d3 | |||
932d79ad57 | |||
a2743842dd | |||
e46cd01f41 | |||
322f2b8959 | |||
bf4118b09d | |||
59d3ee4d37 | |||
a3a8bb1eaa | |||
06b2cd9222 | |||
185738eccc | |||
87feab284e | |||
5ce0b5fa0f | |||
538216944d | |||
dee0a7e8e8 | |||
b3df16f217 | |||
0142ea90ae | |||
1931098ee9 | |||
35dce186fd | |||
bd3d9e8067 | |||
f780e996e0 | |||
dcdf2e8304 | |||
f8fa5a005a | |||
70123a7261 | |||
1caa4efdb4 | |||
73ad2f0eb3 | |||
6503af6a98 | |||
67d334a60b | |||
fae0def6a8 | |||
35ab075703 | |||
0b7bf1db99 | |||
40fb9228a2 | |||
4ee09238d8 | |||
6875917ec7 | |||
cdd28d2184 | |||
934bff1454 | |||
9c7e808794 | |||
9917356b40 | |||
e1dfb66fae | |||
a3df217992 | |||
e94ca5e8c4 | |||
66767da36a | |||
b75ed16a3e | |||
14cf97d473 | |||
c68c504b53 | |||
46b4969da5 | |||
c9dea01644 | |||
d4fd7c5044 | |||
473192e34b | |||
d1789b634e | |||
2dfb11dc0f | |||
9cbeb5fbb0 | |||
2cfaf5959d | |||
b8980bd219 | |||
339c93905f | |||
675ca9d5e3 | |||
4553f964f3 | |||
dbe352acac | |||
606c25c2c3 | |||
a0b92ba468 | |||
f7efa85cdd | |||
0d5ff79b96 | |||
abf02cf90d | |||
e3de5c7624 | |||
8ba1dfa7c7 | |||
cbcf7c9c8c | |||
b66d0d9563 | |||
a60534a5c2 | |||
94bfca95ca | |||
662f9cd5ed | |||
d37269bf44 | |||
c89d5a46d4 | |||
01459544a5 | |||
3a5e593a65 |
36 changed files with 1526 additions and 5105 deletions
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -5,3 +5,5 @@ zenith.db
|
|||
zenith.log
|
||||
zenith.db-shm
|
||||
zenith.db-wal
|
||||
docker_files/zenithrpc-docker_0.7.0.0.7z
|
||||
docker_files/zenithrpc-docker_0.7.0.0/
|
||||
|
|
2
.gitmodules
vendored
2
.gitmodules
vendored
|
@ -1,4 +1,4 @@
|
|||
[submodule "zcash-haskell"]
|
||||
path = zcash-haskell
|
||||
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
||||
branch = master
|
||||
branch = milestone2
|
||||
|
|
33
CHANGELOG.md
33
CHANGELOG.md
|
@ -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/),
|
||||
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
|
||||
|
||||
## [0.7.0.0-beta]
|
||||
## [Unreleased]
|
||||
|
||||
### Added
|
||||
|
||||
- RPC module
|
||||
- OpenRPC specification
|
||||
- `listwallets` RPC method
|
||||
- `listaccounts` RPC method
|
||||
- `listaddresses` RPC method
|
||||
- `listreceived` RPC method
|
||||
- `getbalance` RPC method
|
||||
- `getnewwallet` RPC method
|
||||
- `getnewaccount` RPC method
|
||||
- `getnewaddress` RPC method
|
||||
- `getoperationstatus` RPC method
|
||||
- `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)
|
||||
- OpenRPC specification
|
||||
- `listwallets` RPC method
|
||||
- `listaccounts` RPC method
|
||||
- `listaddresses` RPC method
|
||||
- `listreceived` RPC method
|
||||
- `getbalance` RPC method
|
||||
- `getnewwallet` RPC method
|
||||
- `getnewaccount` RPC method
|
||||
- `getnewaddress` RPC method
|
||||
- `getoperationstatus` RPC method
|
||||
|
||||
### Changed
|
||||
|
||||
- Detection of changes in database schema for automatic re-scan
|
||||
- Block tracking for chain re-org detection
|
||||
- Refactored `ZcashPool`
|
||||
- Preventing write operations to occur during wallet sync
|
||||
|
||||
|
||||
## [0.6.0.0-beta]
|
||||
|
||||
|
|
|
@ -230,7 +230,6 @@ main = do
|
|||
"gui" -> runZenithGUI myConfig
|
||||
"tui" -> runZenithTUI myConfig
|
||||
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
||||
"resync" -> clearSync myConfig
|
||||
_ -> printUsage
|
||||
else printUsage
|
||||
|
||||
|
|
|
@ -2,29 +2,17 @@
|
|||
|
||||
module Server where
|
||||
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (throwIO, throwTo, try)
|
||||
import Control.Monad (forever, when)
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Data.Configurator
|
||||
import qualified Data.Text as T
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Servant
|
||||
import System.Exit
|
||||
import System.Posix.Signals
|
||||
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
|
||||
import Zenith.Core (checkBlockChain, checkZebra)
|
||||
import Zenith.DB (getWallets, initDb, initPool)
|
||||
import Zenith.RPC
|
||||
( State(..)
|
||||
, ZenithRPC(..)
|
||||
, authenticate
|
||||
, scanZebra
|
||||
, zenithServer
|
||||
)
|
||||
import Zenith.DB (initDb)
|
||||
import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
|
||||
import Zenith.Scanner (rescanZebra)
|
||||
import Zenith.Types (Config(..))
|
||||
import Zenith.Utils (getZenithPath)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
@ -35,9 +23,7 @@ main = do
|
|||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
nodePort <- require config "nodePort"
|
||||
dbFP <- getZenithPath
|
||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||
let myConfig = Config dbFileName zebraHost zebraPort nodeUser nodePwd nodePort
|
||||
let ctx = authenticate myConfig :. EmptyContext
|
||||
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
|
||||
case w of
|
||||
|
@ -48,44 +34,21 @@ main = do
|
|||
case bc of
|
||||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
x <- initDb dbFilePath
|
||||
x <- initDb dbFileName
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra zebraHost zebraPort dbFilePath
|
||||
pool <- runNoLoggingT $ initPool dbFilePath
|
||||
walList <- getWallets pool $ zgb_net chainInfo
|
||||
if not (null walList)
|
||||
then do
|
||||
scanThread <-
|
||||
forkIO $
|
||||
forever $ do
|
||||
_ <-
|
||||
scanZebra
|
||||
dbFilePath
|
||||
zebraHost
|
||||
zebraPort
|
||||
(zgb_net chainInfo)
|
||||
threadDelay 90000000
|
||||
putStrLn "Zenith RPC Server 0.7.0.0-beta"
|
||||
putStrLn "------------------------------"
|
||||
putStrLn $
|
||||
"Connected to " ++
|
||||
show (zgb_net chainInfo) ++
|
||||
" Zebra " ++
|
||||
T.unpack (zgi_build zebra) ++ " on port " ++ show zebraPort
|
||||
let myState =
|
||||
State
|
||||
(zgb_net chainInfo)
|
||||
zebraHost
|
||||
zebraPort
|
||||
dbFilePath
|
||||
(zgi_build zebra)
|
||||
(zgb_blocks chainInfo)
|
||||
run nodePort $
|
||||
serveWithContext
|
||||
(Proxy :: Proxy ZenithRPC)
|
||||
ctx
|
||||
(zenithServer myState)
|
||||
else putStrLn
|
||||
"No wallets available. Please start Zenith interactively to create a wallet"
|
||||
when x' $ rescanZebra zebraHost zebraPort dbFileName
|
||||
let myState =
|
||||
State
|
||||
(zgb_net chainInfo)
|
||||
zebraHost
|
||||
zebraPort
|
||||
dbFileName
|
||||
(zgi_build zebra)
|
||||
(zgb_blocks chainInfo)
|
||||
run nodePort $
|
||||
serveWithContext
|
||||
(Proxy :: Proxy ZenithRPC)
|
||||
ctx
|
||||
(zenithServer myState)
|
||||
|
|
48
docker_files/Dockerfile
Normal file
48
docker_files/Dockerfile
Normal 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"]
|
BIN
docker_files/Downloads/libc-bin_2.38-1ubuntu6_amd64.deb
Normal file
BIN
docker_files/Downloads/libc-bin_2.38-1ubuntu6_amd64.deb
Normal file
Binary file not shown.
BIN
docker_files/Downloads/libc-dev-bin_2.38-1ubuntu6_amd64.deb
Normal file
BIN
docker_files/Downloads/libc-dev-bin_2.38-1ubuntu6_amd64.deb
Normal file
Binary file not shown.
BIN
docker_files/Downloads/libc6_2.38-1ubuntu6_amd64.deb
Normal file
BIN
docker_files/Downloads/libc6_2.38-1ubuntu6_amd64.deb
Normal file
Binary file not shown.
6
docker_files/bin/startrpc
Executable file
6
docker_files/bin/startrpc
Executable 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
BIN
docker_files/bin/zenithserver
Executable file
Binary file not shown.
43
docker_files/cfg/runzenithrpc
Executable file
43
docker_files/cfg/runzenithrpc
Executable 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
|
5
docker_files/cfg/zenith.cfg
Normal file
5
docker_files/cfg/zenith.cfg
Normal 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
59
docker_files/dockerpkg
Executable 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
|
BIN
docker_files/lib/librustzcash_wrapper.so
Executable file
BIN
docker_files/lib/librustzcash_wrapper.so
Executable file
Binary file not shown.
BIN
docker_files/lib/sapling-output.params
Normal file
BIN
docker_files/lib/sapling-output.params
Normal file
Binary file not shown.
BIN
docker_files/lib/sapling-spend.params
Normal file
BIN
docker_files/lib/sapling-spend.params
Normal file
Binary file not shown.
100
docker_files/scripts/bash_rc_adm
Normal file
100
docker_files/scripts/bash_rc_adm
Normal 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
|
118
docker_files/scripts/bash_rc_usr
Normal file
118
docker_files/scripts/bash_rc_usr
Normal 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
|
8
docker_files/scripts/welcome.sh
Normal file
8
docker_files/scripts/welcome.sh
Normal 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
70
docker_files/setup_docker
Normal 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
|
|
@ -2,7 +2,6 @@
|
|||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Zenith.CLI where
|
||||
|
||||
|
@ -19,7 +18,6 @@ import Brick.Forms
|
|||
, handleFormEvent
|
||||
, invalidFormInputAttr
|
||||
, newForm
|
||||
, radioField
|
||||
, renderForm
|
||||
, setFieldValid
|
||||
, updateFormState
|
||||
|
@ -63,19 +61,12 @@ import qualified Brick.Widgets.List as L
|
|||
import qualified Brick.Widgets.ProgressBar as P
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
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.Logger
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logDebugN
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString (HexString(..), toText)
|
||||
import Data.Maybe
|
||||
import Data.Scientific (Scientific, scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
@ -91,39 +82,25 @@ import System.Hclip
|
|||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeTransparentAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
||||
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, HexStringDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ShieldDeshieldOp(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
import Zenith.Utils
|
||||
( displayTaz
|
||||
, displayZec
|
||||
, getChainTip
|
||||
, isRecipientValid
|
||||
, isRecipientValidGUI
|
||||
, jsonNumber
|
||||
, parseAddress
|
||||
, showAddress
|
||||
, validBarValue
|
||||
)
|
||||
|
@ -142,14 +119,6 @@ data Name
|
|||
| ABList
|
||||
| DescripField
|
||||
| AddressField
|
||||
| PrivacyNoneField
|
||||
| PrivacyLowField
|
||||
| PrivacyMediumField
|
||||
| PrivacyFullField
|
||||
| ShieldField
|
||||
| DeshieldField
|
||||
| TotalTranspField
|
||||
| TotalShieldedField
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
data DialogInput = DialogInput
|
||||
|
@ -160,9 +129,8 @@ makeLenses ''DialogInput
|
|||
|
||||
data SendInput = SendInput
|
||||
{ _sendTo :: !T.Text
|
||||
, _sendAmt :: !Scientific
|
||||
, _sendAmt :: !Float
|
||||
, _sendMemo :: !T.Text
|
||||
, _policyField :: !PrivacyPolicy
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''SendInput
|
||||
|
@ -174,12 +142,6 @@ data AdrBookEntry = AdrBookEntry
|
|||
|
||||
makeLenses ''AdrBookEntry
|
||||
|
||||
newtype ShDshEntry = ShDshEntry
|
||||
{ _shAmt :: Scientific
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''ShDshEntry
|
||||
|
||||
data DialogType
|
||||
= WName
|
||||
| AName
|
||||
|
@ -192,8 +154,6 @@ data DialogType
|
|||
| AdrBookForm
|
||||
| AdrBookUpdForm
|
||||
| AdrBookDelForm
|
||||
| DeshieldForm
|
||||
| ShieldForm
|
||||
|
||||
data DisplayType
|
||||
= AddrDisplay
|
||||
|
@ -211,9 +171,6 @@ data Tick
|
|||
| TickMsg !String
|
||||
| TickTx !HexString
|
||||
|
||||
data DropDownItem =
|
||||
DropdownItem String
|
||||
|
||||
data State = State
|
||||
{ _network :: !ZcashNet
|
||||
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
||||
|
@ -242,9 +199,6 @@ data State = State
|
|||
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
|
||||
, _sentTx :: !(Maybe HexString)
|
||||
, _unconfBalance :: !Integer
|
||||
, _deshieldForm :: !(Form ShDshEntry () Name)
|
||||
, _tBalance :: !Integer
|
||||
, _sBalance :: !Integer
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
@ -261,11 +215,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(" Zenith - " <>
|
||||
show (st ^. network) <>
|
||||
" - " <>
|
||||
T.unpack
|
||||
(maybe
|
||||
"(None)"
|
||||
(\(_, w) -> zcashWalletName $ entityVal w)
|
||||
(L.listSelectedElement (st ^. wallets))) ++
|
||||
(T.unpack
|
||||
(maybe
|
||||
"(None)"
|
||||
(\(_, w) -> zcashWalletName $ entityVal w)
|
||||
(L.listSelectedElement (st ^. wallets)))) ++
|
||||
" "))
|
||||
(C.hCenter
|
||||
(str
|
||||
|
@ -292,24 +246,17 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(C.hCenter
|
||||
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
|
||||
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
|
||||
(vBox
|
||||
[ C.hCenter
|
||||
(hBox
|
||||
[ capCommand "W" "allets"
|
||||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand3 "" "S" "end Tx"
|
||||
])
|
||||
, C.hCenter
|
||||
(hBox
|
||||
[ capCommand2 "Address " "B" "ook"
|
||||
, capCommand2 "s" "H" "ield"
|
||||
, capCommand "D" "e-shield"
|
||||
, capCommand "Q" "uit"
|
||||
, capCommand "?" " Help"
|
||||
, str $ show (st ^. timer)
|
||||
])
|
||||
])
|
||||
C.hCenter
|
||||
(hBox
|
||||
[ capCommand "W" "allets"
|
||||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand "S" "end Tx"
|
||||
, capCommand2 "Address " "B" "ook"
|
||||
, capCommand "Q" "uit"
|
||||
, capCommand "?" " Help"
|
||||
, str $ show (st ^. timer)
|
||||
])
|
||||
listBox :: Show e => String -> L.List Name e -> Widget Name
|
||||
listBox titleLabel l =
|
||||
C.vCenter $
|
||||
|
@ -375,7 +322,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
else emptyWidget
|
||||
where
|
||||
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 =
|
||||
map
|
||||
(hLimit 40 . str)
|
||||
|
@ -386,7 +333,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, "View address"
|
||||
, "Send Tx"
|
||||
, "Address Book"
|
||||
, "Shield/De-Shield"
|
||||
, "Quit"
|
||||
]
|
||||
inputDialog :: State -> Widget Name
|
||||
|
@ -433,37 +379,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(renderForm (st ^. txForm) <=>
|
||||
C.hCenter
|
||||
(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
|
||||
-- Address Book List
|
||||
AdrBook ->
|
||||
|
@ -528,7 +443,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(str
|
||||
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
|
||||
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..."))
|
||||
else emptyWidget
|
||||
capCommand3 :: String -> String -> String -> Widget Name
|
||||
|
@ -688,34 +603,14 @@ mkInputForm =
|
|||
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
|
||||
mkSendForm bal =
|
||||
newForm
|
||||
[ label "Privacy Level :" @@=
|
||||
radioField
|
||||
policyField
|
||||
[ (Full, PrivacyFullField, "Full")
|
||||
, (Medium, PrivacyMediumField, "Medium")
|
||||
, (Low, PrivacyLowField, "Low")
|
||||
, (None, PrivacyNoneField, "None")
|
||||
]
|
||||
, label "To: " @@= editTextField sendTo RecField (Just 1)
|
||||
[ label "To: " @@= editTextField sendTo RecField (Just 1)
|
||||
, label "Amount: " @@=
|
||||
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
|
||||
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||
mkDeshieldForm tbal =
|
||||
newForm
|
||||
[ label "Amount: " @@=
|
||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
|
@ -821,31 +716,18 @@ abMBarAttr :: A.AttrName
|
|||
abMBarAttr = A.attrName "menubar"
|
||||
|
||||
scanZebra ::
|
||||
T.Text
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> Int
|
||||
-> BC.BChan Tick
|
||||
-> ZcashNet
|
||||
-> NoLoggingT IO ()
|
||||
T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
|
||||
scanZebra dbP zHost zPort b eChan znet = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
|
||||
else do
|
||||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
when (chkBlock /= dbBlock && chkBlock /= 1) $
|
||||
rewindWalletData pool sb $ ZcashNetDB znet
|
||||
pool <- runNoLoggingT $ initPool dbP
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB znet
|
||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 ->
|
||||
liftIO $
|
||||
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
|
||||
Right _ -> do
|
||||
let sb = max dbBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
liftIO $
|
||||
|
@ -857,28 +739,8 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
let step =
|
||||
(1.0 :: Float) /
|
||||
fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||
_ <- liftIO $ startSync pool
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $
|
||||
BC.writeBChan eChan $
|
||||
TickMsg "Failed to update unconfirmed transactions"
|
||||
Right _ -> do
|
||||
logDebugN "Updated confirmations"
|
||||
logDebugN "Starting commitment tree update"
|
||||
_ <- updateCommitmentTrees pool zHost zPort (ZcashNetDB znet)
|
||||
logDebugN "Finished tree update"
|
||||
_ <- liftIO $ completeSync pool Successful
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
||||
return ()
|
||||
else do
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
||||
mapM_ (processBlock pool step) bList
|
||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||
where
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
|
@ -890,9 +752,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
@ -902,21 +762,19 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
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 znet)
|
||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
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.AppEvent t) = do
|
||||
|
@ -926,35 +784,7 @@ appEvent (BT.AppEvent t) = do
|
|||
TickMsg m -> do
|
||||
case s ^. displayBox of
|
||||
AddrDisplay -> return ()
|
||||
MsgDisplay -> do
|
||||
when (m == "startSync") $ do
|
||||
selWallet <-
|
||||
do case L.listSelectedElement $ s ^. wallets of
|
||||
Nothing -> do
|
||||
let fWall =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. wallets
|
||||
case fWall of
|
||||
Nothing -> throw $ userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
_ <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
syncWallet
|
||||
(Config
|
||||
(s ^. dbPath)
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
"user"
|
||||
"pwd"
|
||||
8080)
|
||||
selWallet
|
||||
updatedState <- BT.get
|
||||
ns <- liftIO $ refreshWallet updatedState
|
||||
BT.put ns
|
||||
BT.modify $ set msg ""
|
||||
BT.modify $ set displayBox BlankDisplay
|
||||
MsgDisplay -> return ()
|
||||
PhraseDisplay -> return ()
|
||||
TxDisplay -> return ()
|
||||
TxIdDisplay -> return ()
|
||||
|
@ -977,9 +807,32 @@ appEvent (BT.AppEvent t) = do
|
|||
SyncDisplay -> do
|
||||
if s ^. barValue == 1.0
|
||||
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 displayBox MsgDisplay
|
||||
updatedState <- BT.get
|
||||
ns <- liftIO $ refreshWallet updatedState
|
||||
BT.put ns
|
||||
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
|
||||
BlankDisplay -> do
|
||||
case s ^. dialogBox of
|
||||
|
@ -993,20 +846,15 @@ appEvent (BT.AppEvent t) = do
|
|||
AdrBookForm -> return ()
|
||||
AdrBookUpdForm -> return ()
|
||||
AdrBookDelForm -> return ()
|
||||
DeshieldForm -> return ()
|
||||
ShieldForm -> return ()
|
||||
Blank -> do
|
||||
if s ^. timer == 90
|
||||
then do
|
||||
BT.modify $ set barValue 0.0
|
||||
BT.modify $ set displayBox SyncDisplay
|
||||
sBlock <-
|
||||
liftIO $
|
||||
getMinBirthdayHeight pool (ZcashNetDB $ s ^. network)
|
||||
sBlock <- liftIO $ getMinBirthdayHeight pool
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
runNoLoggingT $
|
||||
scanZebra
|
||||
(s ^. dbPath)
|
||||
(s ^. zebraHost)
|
||||
|
@ -1215,8 +1063,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
Just (_k, w) -> return w
|
||||
fs1 <- BT.zoom txForm $ BT.gets formState
|
||||
bl <-
|
||||
liftIO $
|
||||
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
|
@ -1231,7 +1078,6 @@ appEvent (BT.VtyEvent e) = do
|
|||
(fs1 ^. sendAmt)
|
||||
(fs1 ^. sendTo)
|
||||
(fs1 ^. sendMemo)
|
||||
(fs1 ^. policyField)
|
||||
BT.modify $ set msg "Preparing transaction..."
|
||||
BT.modify $ set displayBox SendDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
|
@ -1245,103 +1091,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
fs <- BT.gets formState
|
||||
BT.modify $
|
||||
setFieldValid
|
||||
(isRecipientValidGUI
|
||||
(fs ^. policyField)
|
||||
(fs ^. sendTo))
|
||||
(isRecipientValid (fs ^. sendTo))
|
||||
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
|
||||
case e of
|
||||
V.EvKey (V.KChar 'x') [] ->
|
||||
|
@ -1359,7 +1110,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
"Address copied to Clipboard from >>\n" ++
|
||||
T.unpack (addressBookAbdescrip (entityVal a))
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
_any -> do
|
||||
_ -> do
|
||||
BT.modify $
|
||||
set msg "Error while copying the address!!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
|
@ -1374,8 +1125,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
(SendInput
|
||||
(addressBookAbaddress (entityVal a))
|
||||
0.0
|
||||
""
|
||||
Full)
|
||||
"")
|
||||
BT.modify $ set dialogBox SendTx
|
||||
_ -> do
|
||||
BT.modify $
|
||||
|
@ -1525,53 +1275,6 @@ appEvent (BT.VtyEvent e) = do
|
|||
BT.put s'
|
||||
BT.modify $ set dialogBox AdrBook
|
||||
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
|
||||
Blank -> do
|
||||
case e of
|
||||
|
@ -1594,61 +1297,10 @@ appEvent (BT.VtyEvent e) = do
|
|||
V.EvKey (V.KChar 's') [] -> do
|
||||
BT.modify $
|
||||
set txForm $
|
||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "")
|
||||
BT.modify $ set dialogBox SendTx
|
||||
V.EvKey (V.KChar 'b') [] ->
|
||||
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 ->
|
||||
case r of
|
||||
Just AList ->
|
||||
|
@ -1663,8 +1315,6 @@ appEvent (BT.VtyEvent e) = do
|
|||
printMsg s = BT.modify $ updateMsg s
|
||||
updateMsg :: String -> State -> State
|
||||
updateMsg = set msg
|
||||
-- fs <- BT.gets formState
|
||||
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
|
||||
appEvent _ = return ()
|
||||
|
||||
theMap :: A.AttrMap
|
||||
|
@ -1714,7 +1364,6 @@ runZenithTUI config = do
|
|||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
x <- initDb dbFilePath
|
||||
_ <- upgradeQrTable pool
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
|
@ -1747,14 +1396,6 @@ runZenithTUI config = do
|
|||
if not (null accList)
|
||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
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
|
||||
_ <-
|
||||
forkIO $
|
||||
|
@ -1768,7 +1409,7 @@ runZenithTUI config = do
|
|||
State
|
||||
(zgb_net chainInfo)
|
||||
(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 TList (Vec.fromList txList) 1)
|
||||
("Start up Ok! Connected to Zebra " ++
|
||||
|
@ -1791,15 +1432,12 @@ runZenithTUI config = do
|
|||
1.0
|
||||
eventChan
|
||||
0
|
||||
(mkSendForm 0 $ SendInput "" 0.0 "" Full)
|
||||
(mkSendForm 0 $ SendInput "" 0.0 "")
|
||||
(L.list ABList (Vec.fromList abookList) 1)
|
||||
(mkNewABForm (AdrBookEntry "" ""))
|
||||
""
|
||||
Nothing
|
||||
uBal
|
||||
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
||||
tBal
|
||||
sBal
|
||||
Left _e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
@ -1819,7 +1457,7 @@ refreshWallet s = do
|
|||
Just (j, w1) -> return (j, w1)
|
||||
Just (k, w) -> return (k, w)
|
||||
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
|
||||
let bl = zcashWalletLastSync $ entityVal $ walList !! ix
|
||||
let bl = zcashWalletLastSync $ entityVal selWallet
|
||||
addrL <-
|
||||
if not (null aL)
|
||||
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
|
||||
|
@ -2010,37 +1648,22 @@ sendTransaction ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Scientific
|
||||
-> Float
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
-> 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..."
|
||||
case parseAddress (E.encodeUtf8 ua) of
|
||||
case parseAddress ua znet of
|
||||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||
Just outUA -> do
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
accId
|
||||
bl
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI outUA)
|
||||
amt
|
||||
(if memo == ""
|
||||
then Nothing
|
||||
else Just memo)
|
||||
]
|
||||
policy
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
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
|
||||
|
@ -2050,56 +1673,3 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
|||
case resp of
|
||||
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
|
||||
Right txId -> BC.writeBChan chan $ TickTx txId
|
||||
|
||||
shieldTransaction ::
|
||||
ConnectionPool
|
||||
-> BC.BChan Tick
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> IO ()
|
||||
shieldTransaction pool chan zHost zPort znet accId bl = do
|
||||
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
|
||||
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
|
||||
forM_ res $ \case
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
resp <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ toText rawTx]
|
||||
case resp of
|
||||
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
|
||||
Right txId -> BC.writeBChan chan $ TickTx txId
|
||||
|
||||
deshieldTransaction ::
|
||||
ConnectionPool
|
||||
-> BC.BChan Tick
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> ProposedNote
|
||||
-> IO ()
|
||||
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
|
||||
BC.writeBChan chan $ TickMsg "Deshielding funds..."
|
||||
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
resp <-
|
||||
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
|
||||
|
|
1383
src/Zenith/Core.hs
1383
src/Zenith/Core.hs
File diff suppressed because it is too large
Load diff
1161
src/Zenith/DB.hs
1161
src/Zenith/DB.hs
File diff suppressed because it is too large
Load diff
|
@ -1,7 +1,6 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Zenith.GUI where
|
||||
|
||||
|
@ -11,20 +10,13 @@ import Codec.QRCode
|
|||
import Codec.QRCode.JuicyPixels
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (forM_, unless, when)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logDebugN
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString (toText)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Scientific (Scientific, fromFloatDigits)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
@ -40,21 +32,13 @@ import Text.Printf
|
|||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||
import TextShow hiding (toText)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeTransparentAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, Scope(..)
|
||||
, ToBytes(..)
|
||||
, UnifiedAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
, ZebraGetInfo(..)
|
||||
|
@ -63,18 +47,20 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
|||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.GUI.Theme
|
||||
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
||||
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||
import Zenith.Types hiding (ZcashAddress(..))
|
||||
import Zenith.Utils
|
||||
( displayAmount
|
||||
, getChainTip
|
||||
, isRecipientValidGUI
|
||||
, getZenithPath
|
||||
, isEmpty
|
||||
, isRecipientValid
|
||||
, isValidString
|
||||
, isZecAddressValid
|
||||
, jsonNumber
|
||||
, padWithZero
|
||||
, parseAddress
|
||||
, showAddress
|
||||
, validBarValue
|
||||
, validateAddressBool
|
||||
)
|
||||
|
||||
data AppEvent
|
||||
|
@ -95,7 +81,7 @@ data AppEvent
|
|||
| SwitchAddr !Int
|
||||
| SwitchAcc !Int
|
||||
| SwitchWal !Int
|
||||
| UpdateBalance !(Integer, Integer, Integer, Integer)
|
||||
| UpdateBalance !(Integer, Integer)
|
||||
| CopyAddr !(Maybe (Entity WalletAddress))
|
||||
| LoadTxs ![Entity UserTx]
|
||||
| LoadAddrs ![Entity WalletAddress]
|
||||
|
@ -130,6 +116,7 @@ data AppEvent
|
|||
| CheckValidAddress !T.Text
|
||||
| CheckValidDescrip !T.Text
|
||||
| SaveNewABEntry
|
||||
| SaveABDescription !T.Text
|
||||
| UpdateABEntry !T.Text !T.Text
|
||||
| CloseUpdABEntry
|
||||
| ShowMessage !T.Text
|
||||
|
@ -138,15 +125,6 @@ data AppEvent
|
|||
| CopyABAdress !T.Text
|
||||
| DeleteABEntry !T.Text
|
||||
| UpdateABDescrip !T.Text !T.Text
|
||||
| ResetRecipientValid
|
||||
| ShowShield
|
||||
| CloseShield
|
||||
| ShowDeShield
|
||||
| CloseDeShield
|
||||
| SendDeShield
|
||||
| SendShield
|
||||
| StartSync
|
||||
| TreeSync
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppModel = AppModel
|
||||
|
@ -199,13 +177,6 @@ data AppModel = AppModel
|
|||
, _msgAB :: !(Maybe T.Text)
|
||||
, _showABAddress :: !Bool
|
||||
, _updateABAddress :: !Bool
|
||||
, _privacyChoice :: !PrivacyPolicy
|
||||
, _shieldZec :: !Bool
|
||||
, _deShieldZec :: !Bool
|
||||
, _tBalance :: !Integer
|
||||
, _tBalanceValid :: !Bool
|
||||
, _sBalance :: !Integer
|
||||
, _sBalanceValid :: !Bool
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''AppModel
|
||||
|
@ -255,8 +226,6 @@ buildUI wenv model = widgetTree
|
|||
, updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
|
||||
model ^.
|
||||
updateABAddress
|
||||
, shieldOverlay `nodeVisible` model ^. shieldZec
|
||||
, deShieldOverlay `nodeVisible` model ^. deShieldZec
|
||||
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
|
||||
]
|
||||
mainWindow =
|
||||
|
@ -322,10 +291,6 @@ buildUI wenv model = widgetTree
|
|||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic`
|
||||
[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`
|
||||
[bgColor btnColor, padding 3]
|
||||
newBox =
|
||||
|
@ -452,43 +417,43 @@ buildUI wenv model = widgetTree
|
|||
[ vstack
|
||||
[ tooltip "Unified" $
|
||||
box_
|
||||
[onClick (SetPool OrchardPool)]
|
||||
[onClick (SetPool Orchard)]
|
||||
(remixIcon remixShieldCheckFill `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == OrchardPool)
|
||||
(model ^. selPool == Orchard)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == OrchardPool)
|
||||
(model ^. selPool == Orchard)
|
||||
(textColor white)
|
||||
])
|
||||
, filler
|
||||
, tooltip "Legacy Shielded" $
|
||||
box_
|
||||
[onClick (SetPool SaplingPool)]
|
||||
[onClick (SetPool Sapling)]
|
||||
(remixIcon remixShieldLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == SaplingPool)
|
||||
(model ^. selPool == Sapling)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == SaplingPool)
|
||||
(model ^. selPool == Sapling)
|
||||
(textColor white)
|
||||
])
|
||||
, filler
|
||||
, tooltip "Transparent" $
|
||||
box_
|
||||
[onClick (SetPool TransparentPool)]
|
||||
[onClick (SetPool Transparent)]
|
||||
(remixIcon remixEyeLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == TransparentPool)
|
||||
(model ^. selPool == Transparent)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == TransparentPool)
|
||||
(model ^. selPool == Transparent)
|
||||
(textColor white)
|
||||
])
|
||||
] `styleBasic`
|
||||
|
@ -501,10 +466,10 @@ buildUI wenv model = widgetTree
|
|||
(hstack
|
||||
[ label
|
||||
(case model ^. selPool of
|
||||
OrchardPool -> "Unified"
|
||||
SaplingPool -> "Legacy Shielded"
|
||||
TransparentPool -> "Transparent"
|
||||
SproutPool -> "Unknown") `styleBasic`
|
||||
Orchard -> "Unified"
|
||||
Sapling -> "Legacy Shielded"
|
||||
Transparent -> "Transparent"
|
||||
Sprout -> "Unknown") `styleBasic`
|
||||
[textColor white]
|
||||
, remixIcon remixFileCopyFill `styleBasic`
|
||||
[textSize 14, padding 4, textColor white]
|
||||
|
@ -640,28 +605,7 @@ buildUI wenv model = widgetTree
|
|||
, separatorLine `styleBasic` [fgColor btnColor]
|
||||
, spacer
|
||||
, hstack
|
||||
[ label "Privacy Level:" `styleBasic`
|
||||
[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"]
|
||||
[ label "To:" `styleBasic` [width 50]
|
||||
, spacer
|
||||
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
|
||||
[ width 150
|
||||
|
@ -671,8 +615,7 @@ buildUI wenv model = widgetTree
|
|||
]
|
||||
]
|
||||
, hstack
|
||||
[ label "Amount:" `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
[ label "Amount:" `styleBasic` [width 50]
|
||||
, spacer
|
||||
, numericField_
|
||||
sendAmount
|
||||
|
@ -690,14 +633,12 @@ buildUI wenv model = widgetTree
|
|||
]
|
||||
]
|
||||
, hstack
|
||||
[ label "Memo:" `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
[ label "Memo:" `styleBasic` [width 50]
|
||||
, spacer
|
||||
, textArea sendMemo `styleBasic`
|
||||
[width 150, height 40]
|
||||
]
|
||||
, spacer
|
||||
-- Radio button group for privacy level
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(hstack
|
||||
|
@ -757,7 +698,7 @@ buildUI wenv model = widgetTree
|
|||
box
|
||||
(label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
|
||||
[textSize 12, textFont "Bold"]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.7)]
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
txOverlay =
|
||||
case model ^. showTx of
|
||||
Nothing -> alert CloseTx $ label "N/A"
|
||||
|
@ -991,121 +932,6 @@ buildUI wenv model = widgetTree
|
|||
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
|
||||
, 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
|
||||
|
||||
|
@ -1122,9 +948,9 @@ generateQRCodes config = do
|
|||
if not (null s)
|
||||
then return ()
|
||||
else do
|
||||
generateOneQr pool OrchardPool wAddr
|
||||
generateOneQr pool SaplingPool wAddr
|
||||
generateOneQr pool TransparentPool wAddr
|
||||
generateOneQr pool Orchard wAddr
|
||||
generateOneQr pool Sapling wAddr
|
||||
generateOneQr pool Transparent wAddr
|
||||
generateOneQr ::
|
||||
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
|
||||
generateOneQr p zp wAddr =
|
||||
|
@ -1159,7 +985,7 @@ generateQRCodes config = do
|
|||
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
|
||||
dispAddr zp w =
|
||||
case zp of
|
||||
TransparentPool ->
|
||||
Transparent ->
|
||||
T.append "zcash:" .
|
||||
encodeTransparentReceiver
|
||||
(maybe
|
||||
|
@ -1171,12 +997,11 @@ generateQRCodes config = do
|
|||
(t_rec =<<
|
||||
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||
w)
|
||||
SaplingPool ->
|
||||
Sapling ->
|
||||
T.append "zcash:" <$>
|
||||
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
|
||||
OrchardPool ->
|
||||
Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
|
||||
SproutPool -> Nothing
|
||||
Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
|
||||
Sprout -> Nothing
|
||||
|
||||
handleEvent ::
|
||||
WidgetEnv AppModel AppEvent
|
||||
|
@ -1231,11 +1056,7 @@ handleEvent wenv node model evt =
|
|||
]
|
||||
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
||||
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
||||
ShowSend ->
|
||||
[ Model $
|
||||
model & openSend .~ True & privacyChoice .~ Full & recipientValid .~
|
||||
False
|
||||
]
|
||||
ShowSend -> [Model $ model & openSend .~ True]
|
||||
SendTx ->
|
||||
case currentAccount of
|
||||
Nothing -> [Event $ ShowError "No account available", Event CancelSend]
|
||||
|
@ -1250,10 +1071,9 @@ handleEvent wenv node model evt =
|
|||
(model ^. network)
|
||||
(entityKey acc)
|
||||
(zcashWalletLastSync $ entityVal wal)
|
||||
(fromFloatDigits $ model ^. sendAmount)
|
||||
(model ^. sendAmount)
|
||||
(model ^. sendRecipient)
|
||||
(model ^. sendMemo)
|
||||
(model ^. privacyChoice)
|
||||
, Event CancelSend
|
||||
]
|
||||
CancelSend ->
|
||||
|
@ -1295,7 +1115,7 @@ handleEvent wenv node model evt =
|
|||
Just wAddr -> getUserTx dbPool $ entityKey wAddr
|
||||
]
|
||||
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 ->
|
||||
[ Model $ model & selAcc .~ i
|
||||
, Task $
|
||||
|
@ -1308,14 +1128,12 @@ handleEvent wenv node model evt =
|
|||
UpdateBalance <$> do
|
||||
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
||||
case selectAccount i of
|
||||
Nothing -> return (0, 0, 0, 0)
|
||||
Nothing -> return (0, 0)
|
||||
Just acc -> do
|
||||
b <- getBalance dbPool $ entityKey acc
|
||||
u <- getUnconfirmedBalance dbPool $ entityKey acc
|
||||
s <- getShieldedBalance dbPool $ entityKey acc
|
||||
t <- getTransparentBalance dbPool $ entityKey acc
|
||||
return (b, u, s, t)
|
||||
, Event $ SetPool OrchardPool
|
||||
return (b, u)
|
||||
, Event $ SetPool Orchard
|
||||
]
|
||||
SwitchWal i ->
|
||||
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
|
||||
|
@ -1326,9 +1144,9 @@ handleEvent wenv node model evt =
|
|||
Nothing -> return []
|
||||
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
|
||||
]
|
||||
UpdateBalance (b, u, s, t) ->
|
||||
UpdateBalance (b, u) ->
|
||||
[ Model $
|
||||
model & balance .~ b & sBalance .~ s & tBalance .~ t & unconfBalance .~
|
||||
model & balance .~ b & unconfBalance .~
|
||||
(if u == 0
|
||||
then Nothing
|
||||
else Just u)
|
||||
|
@ -1338,15 +1156,14 @@ handleEvent wenv node model evt =
|
|||
, setClipboardData $
|
||||
ClipboardText $
|
||||
case model ^. selPool of
|
||||
OrchardPool ->
|
||||
maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||
SaplingPool ->
|
||||
Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||
Sapling ->
|
||||
fromMaybe "None" $
|
||||
(getSaplingFromUA .
|
||||
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
|
||||
a
|
||||
SproutPool -> "None"
|
||||
TransparentPool ->
|
||||
Sprout -> "None"
|
||||
Transparent ->
|
||||
maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
||||
t_rec =<<
|
||||
(isValidUnifiedAddress .
|
||||
|
@ -1369,7 +1186,7 @@ handleEvent wenv node model evt =
|
|||
if not (null a)
|
||||
then [ Model $ model & addresses .~ a
|
||||
, Event $ SwitchAddr $ model ^. selAddr
|
||||
, Event $ SetPool OrchardPool
|
||||
, Event $ SetPool Orchard
|
||||
]
|
||||
else [Event $ NewAddress currentAccount]
|
||||
LoadAccs a ->
|
||||
|
@ -1378,7 +1195,7 @@ handleEvent wenv node model evt =
|
|||
else [Event $ NewAccount currentWallet]
|
||||
LoadWallets a ->
|
||||
if not (null a)
|
||||
then [ Model $ model & wallets .~ a & modalMsg .~ Nothing
|
||||
then [ Model $ model & wallets .~ a
|
||||
, Event $ SwitchWal $ model ^. selWallet
|
||||
]
|
||||
else [Event NewWallet]
|
||||
|
@ -1388,50 +1205,39 @@ handleEvent wenv node model evt =
|
|||
CloseTxId -> [Model $ model & showId .~ Nothing]
|
||||
ShowTx i -> [Model $ model & showTx ?~ i]
|
||||
TickUp ->
|
||||
if isNothing (model ^. modalMsg)
|
||||
then if (model ^. timer) < 90
|
||||
then [Model $ model & timer .~ (1 + model ^. timer)]
|
||||
else if (model ^. barValue) == 1.0
|
||||
then [ Model $
|
||||
model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~
|
||||
"Downloading blocks..."
|
||||
, Producer $
|
||||
runNoLoggingT .
|
||||
scanZebra
|
||||
(c_dbPath $ model ^. configuration)
|
||||
(c_zebraHost $ model ^. configuration)
|
||||
(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
|
||||
]
|
||||
if (model ^. timer) < 90
|
||||
then [Model $ model & timer .~ (1 + model ^. timer)]
|
||||
else if (model ^. barValue) == 1.0
|
||||
then [ Model $ model & timer .~ 0 & barValue .~ 0.0
|
||||
, Producer $
|
||||
scanZebra
|
||||
(c_dbPath $ model ^. configuration)
|
||||
(c_zebraHost $ model ^. configuration)
|
||||
(c_zebraPort $ model ^. configuration)
|
||||
(model ^. network)
|
||||
]
|
||||
else [Model $ model & timer .~ 0]
|
||||
SyncVal i ->
|
||||
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 $
|
||||
model & barValue .~ validBarValue (i + model ^. barValue) &
|
||||
modalMsg ?~
|
||||
("Wallet Sync: " <>
|
||||
T.pack (printf "%.2f%%" (model ^. barValue * 100)))
|
||||
]
|
||||
ResetRecipientValid -> [Model $ model & recipientValid .~ False]
|
||||
CheckRecipient a ->
|
||||
[ Model $
|
||||
model & recipientValid .~ isRecipientValidGUI (model ^. privacyChoice) a
|
||||
]
|
||||
CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
|
||||
CheckAmount i ->
|
||||
[ Model $
|
||||
model & amountValid .~
|
||||
|
@ -1442,7 +1248,7 @@ handleEvent wenv node model evt =
|
|||
-- | Address Book Events
|
||||
-- |
|
||||
CheckValidAddress a ->
|
||||
[Model $ model & abAddressValid .~ isZecAddressValid a]
|
||||
[Model $ model & abAddressValid .~ isRecipientValid a]
|
||||
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
|
||||
ShowAdrBook ->
|
||||
if null (model ^. abaddressList)
|
||||
|
@ -1505,13 +1311,6 @@ handleEvent wenv node model evt =
|
|||
model & msgAB ?~ "Function not implemented..." & menuPopup .~ 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]
|
||||
UpdateABDescrip d a ->
|
||||
[ Task $ updAddrBookDescrip (model ^. configuration) d a
|
||||
|
@ -1524,31 +1323,6 @@ handleEvent wenv node model evt =
|
|||
abList <- getAdrBook dbPool $ model ^. network
|
||||
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
|
||||
currentWallet =
|
||||
if null (model ^. wallets)
|
||||
|
@ -1663,57 +1437,26 @@ handleEvent wenv node model evt =
|
|||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||
return $ ShowMessage "Address Book entry updated!!"
|
||||
|
||||
scanZebra ::
|
||||
T.Text
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> (AppEvent -> IO ())
|
||||
-> NoLoggingT IO ()
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||
scanZebra dbPath zHost zPort net sendMsg = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net
|
||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- liftIO $ checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||
logDebugN $ "dbBlock: " <> T.pack (show dbBlock)
|
||||
logDebugN $ "chkBlock: " <> T.pack (show chkBlock)
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
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
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- liftIO $ getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
let sb = max dbBlock b
|
||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
|
||||
Right _ -> do
|
||||
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
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||
_ <- liftIO $ startSync pool
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $
|
||||
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)
|
||||
mapM_ (processBlock pool step) bList
|
||||
else sendMsg (SyncVal 1.0)
|
||||
where
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
|
@ -1725,9 +1468,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ showt bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg (ShowError $ showt e1)
|
||||
Left e1 -> sendMsg (ShowError $ showt e1)
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
@ -1737,136 +1478,42 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ showt bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg (ShowError $ showt e2)
|
||||
Left e2 -> sendMsg (ShowError $ showt e2)
|
||||
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
|
||||
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
sendMsg (SyncVal step)
|
||||
|
||||
shieldTransaction ::
|
||||
Config -> ZcashNet -> ZcashAccountId -> (AppEvent -> IO ()) -> IO ()
|
||||
shieldTransaction config znet accId sendMsg = do
|
||||
sendMsg $ ShowModal "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
|
||||
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
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
addTime bl t =
|
||||
BlockResponse
|
||||
(bl_confirmations bl)
|
||||
(bl_height bl)
|
||||
(fromIntegral t)
|
||||
(bl_txs bl)
|
||||
|
||||
sendTransaction ::
|
||||
Config
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Scientific
|
||||
-> Float
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
-> (AppEvent -> 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..."
|
||||
case parseAddress (E.encodeUtf8 ua) of
|
||||
case parseAddress ua znet of
|
||||
Nothing -> sendMsg $ ShowError "Incorrect address"
|
||||
Just addr -> do
|
||||
Just outUA -> do
|
||||
let dbPath = c_dbPath config
|
||||
let zHost = c_zebraHost config
|
||||
let zPort = c_zebraPort config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
accId
|
||||
bl
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI addr)
|
||||
amt
|
||||
(if memo == ""
|
||||
then Nothing
|
||||
else Just memo)
|
||||
]
|
||||
policy
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
||||
case res of
|
||||
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
||||
Right rawTx -> do
|
||||
|
@ -1913,7 +1560,6 @@ runZenithGUI config = do
|
|||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
x <- initDb dbFilePath
|
||||
_ <- upgradeQrTable pool
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
|
@ -1936,8 +1582,7 @@ runZenithGUI config = do
|
|||
else return []
|
||||
qr <-
|
||||
if not (null addrList)
|
||||
then getQrCode pool OrchardPool $
|
||||
entityKey $ head addrList
|
||||
then getQrCode pool Orchard $ entityKey $ head addrList
|
||||
else return Nothing
|
||||
bal <-
|
||||
if not (null accList)
|
||||
|
@ -1948,14 +1593,6 @@ runZenithGUI config = do
|
|||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
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 =
|
||||
AppModel
|
||||
config
|
||||
|
@ -1974,7 +1611,7 @@ runZenithGUI config = do
|
|||
(if unconfBal == 0
|
||||
then Nothing
|
||||
else Just unconfBal)
|
||||
OrchardPool
|
||||
Orchard
|
||||
qr
|
||||
False
|
||||
False
|
||||
|
@ -2012,13 +1649,6 @@ runZenithGUI config = do
|
|||
Nothing
|
||||
False
|
||||
False
|
||||
Full
|
||||
False
|
||||
False
|
||||
transBal
|
||||
False
|
||||
shieldBal
|
||||
False
|
||||
startApp model handleEvent buildUI (params hD)
|
||||
Left _e -> print "Zebra not available"
|
||||
where
|
||||
|
|
|
@ -8,28 +8,21 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
|
||||
module Zenith.RPC where
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Exception (try)
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.HexString as H
|
||||
import Data.Int
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import qualified Data.UUID as U
|
||||
import Data.UUID.V4 (nextRandom)
|
||||
import qualified Data.Vector as V
|
||||
import Database.Esqueleto.Experimental
|
||||
( ConnectionPool
|
||||
, entityKey
|
||||
( entityKey
|
||||
, entityVal
|
||||
, fromSqlKey
|
||||
, toSqlKey
|
||||
|
@ -38,73 +31,43 @@ import Servant
|
|||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard (parseAddress)
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, RpcError(..)
|
||||
, Scope(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
( checkBlockChain
|
||||
, createCustomWalletAddress
|
||||
, createZcashAccount
|
||||
, prepareTxV2
|
||||
, syncWallet
|
||||
, updateCommitmentTrees
|
||||
)
|
||||
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
|
||||
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
|
||||
import Zenith.DB
|
||||
( Operation(..)
|
||||
, ZcashAccount(..)
|
||||
, ZcashBlock(..)
|
||||
, ZcashWallet(..)
|
||||
, completeSync
|
||||
, finalizeOperation
|
||||
, findNotesByAddress
|
||||
, getAccountById
|
||||
, getAccounts
|
||||
, getAddressById
|
||||
, getAddresses
|
||||
, getExternalAddresses
|
||||
, getLastSyncBlock
|
||||
, getMaxAccount
|
||||
, getMaxAddress
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
, getOperation
|
||||
, getPoolBalance
|
||||
, getUnconfPoolBalance
|
||||
, getWalletNotes
|
||||
, getWallets
|
||||
, initPool
|
||||
, isSyncing
|
||||
, rewindWalletData
|
||||
, saveAccount
|
||||
, saveAddress
|
||||
, saveBlock
|
||||
, saveOperation
|
||||
, saveWallet
|
||||
, startSync
|
||||
, toZcashAccountAPI
|
||||
, toZcashAddressAPI
|
||||
, toZcashWalletAPI
|
||||
, walletExists
|
||||
)
|
||||
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
|
||||
import Zenith.Types
|
||||
( AccountBalance(..)
|
||||
, Config(..)
|
||||
, HexStringDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZcashNoteAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
, ZenithStatus(..)
|
||||
, ZenithUuid(..)
|
||||
)
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
@ -120,7 +83,6 @@ data ZenithMethod
|
|||
| GetNewAccount
|
||||
| GetNewAddress
|
||||
| GetOperationStatus
|
||||
| SendMany
|
||||
| UnknownMethod
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
@ -135,7 +97,6 @@ instance ToJSON ZenithMethod where
|
|||
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
|
||||
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
||||
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
|
||||
toJSON SendMany = Data.Aeson.String "sendmany"
|
||||
toJSON UnknownMethod = Data.Aeson.Null
|
||||
|
||||
instance FromJSON ZenithMethod where
|
||||
|
@ -151,7 +112,6 @@ instance FromJSON ZenithMethod where
|
|||
"getnewaccount" -> pure GetNewAccount
|
||||
"getnewaddress" -> pure GetNewAddress
|
||||
"getoperationstatus" -> pure GetOperationStatus
|
||||
"sendmany" -> pure SendMany
|
||||
_ -> pure UnknownMethod
|
||||
|
||||
data ZenithParams
|
||||
|
@ -165,7 +125,6 @@ data ZenithParams
|
|||
| NameIdParams !T.Text !Int
|
||||
| NewAddrParams !Int !T.Text !Bool !Bool
|
||||
| OpParams !ZenithUuid
|
||||
| SendParams !Int ![ProposedNote] !PrivacyPolicy
|
||||
| TestParams !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
@ -189,8 +148,6 @@ instance ToJSON ZenithParams where
|
|||
[Data.Aeson.String "ExcludeTransparent" | t]
|
||||
toJSON (OpParams i) =
|
||||
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
|
||||
toJSON (SendParams i ns p) =
|
||||
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
|
||||
|
||||
data ZenithResponse
|
||||
= InfoResponse !T.Text !ZenithInfo
|
||||
|
@ -202,7 +159,6 @@ data ZenithResponse
|
|||
| NewItemResponse !T.Text !Int64
|
||||
| NewAddrResponse !T.Text !ZcashAddressAPI
|
||||
| OpResponse !T.Text !Operation
|
||||
| SendResponse !T.Text !U.UUID
|
||||
| ErrorResponse !T.Text !Double !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
@ -223,7 +179,6 @@ instance ToJSON ZenithResponse where
|
|||
toJSON (NewItemResponse i ix) = packRpcResponse i ix
|
||||
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
||||
toJSON (OpResponse i u) = packRpcResponse i u
|
||||
toJSON (SendResponse i o) = packRpcResponse i o
|
||||
|
||||
instance FromJSON ZenithResponse where
|
||||
parseJSON =
|
||||
|
@ -303,10 +258,6 @@ instance FromJSON ZenithResponse where
|
|||
case floatingOrInteger k of
|
||||
Left _e -> fail "Unknown value"
|
||||
Right k' -> pure $ NewItemResponse i k'
|
||||
String s -> do
|
||||
case U.fromText s of
|
||||
Nothing -> fail "Unknown value"
|
||||
Just u -> pure $ SendResponse i u
|
||||
_anyOther -> fail "Malformed JSON"
|
||||
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
|
||||
|
||||
|
@ -465,30 +416,6 @@ instance FromJSON RpcCall where
|
|||
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
|
||||
else pure $ RpcCall v i GetOperationStatus BadParams
|
||||
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
|
||||
SendMany -> do
|
||||
p <- obj .: "params"
|
||||
case p of
|
||||
Array a ->
|
||||
if V.length a >= 2
|
||||
then do
|
||||
acc <- parseJSON $ a V.! 0
|
||||
x <- parseJSON $ a V.! 1
|
||||
case x of
|
||||
String _ -> do
|
||||
x' <- parseJSON $ a V.! 1
|
||||
y <- parseJSON $ a V.! 2
|
||||
if not (null y)
|
||||
then pure $ RpcCall v i SendMany (SendParams acc y x')
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
Array _ -> do
|
||||
x' <- parseJSON $ a V.! 1
|
||||
if not (null x')
|
||||
then pure $
|
||||
RpcCall v i SendMany (SendParams acc x' Full)
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||
else pure $ RpcCall v i SendMany BadParams
|
||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||
|
||||
type ZenithRPC
|
||||
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
||||
|
@ -646,35 +573,27 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
case parameters req of
|
||||
NameParams t -> do
|
||||
let dbPath = w_dbPath state
|
||||
sP <- liftIO generateWalletSeedPhrase
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
sP <- liftIO generateWalletSeedPhrase
|
||||
r <-
|
||||
liftIO $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
t
|
||||
(ZcashNetDB $ w_network state)
|
||||
(PhraseDB sP)
|
||||
(w_startBlock state)
|
||||
0
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just r' ->
|
||||
return $
|
||||
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
||||
r <-
|
||||
liftIO $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
t
|
||||
(ZcashNetDB $ w_network state)
|
||||
(PhraseDB sP)
|
||||
(w_startBlock state)
|
||||
0
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just r' ->
|
||||
return $
|
||||
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetNewAccount ->
|
||||
|
@ -682,45 +601,34 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
NameIdParams t i -> do
|
||||
let dbPath = w_dbPath state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
w <- liftIO $ walletExists pool i
|
||||
case w of
|
||||
Just w' -> do
|
||||
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
||||
nAcc <-
|
||||
liftIO
|
||||
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
||||
(Either IOError ZcashAccount))
|
||||
case nAcc of
|
||||
Left e ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||
Right nAcc' -> do
|
||||
r <- liftIO $ saveAccount pool nAcc'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just x ->
|
||||
return $
|
||||
NewItemResponse (callId req) $
|
||||
fromSqlKey $ entityKey x
|
||||
Nothing ->
|
||||
w <- liftIO $ walletExists pool i
|
||||
case w of
|
||||
Just w' -> do
|
||||
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
||||
nAcc <-
|
||||
liftIO
|
||||
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
||||
(Either IOError ZcashAccount))
|
||||
case nAcc of
|
||||
Left e ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32008)
|
||||
"Wallet does not exist."
|
||||
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||
Right nAcc' -> do
|
||||
r <- liftIO $ saveAccount pool nAcc'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just x ->
|
||||
return $
|
||||
NewItemResponse (callId req) $
|
||||
fromSqlKey $ entityKey x
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32008) "Wallet does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetNewAddress ->
|
||||
|
@ -729,49 +637,35 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
let dbPath = w_dbPath state
|
||||
let net = w_network state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
maxAddr <-
|
||||
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||
newAddr <-
|
||||
liftIO $
|
||||
createCustomWalletAddress
|
||||
n
|
||||
(maxAddr + 1)
|
||||
net
|
||||
External
|
||||
acc'
|
||||
s
|
||||
t
|
||||
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||
case dbAddr of
|
||||
Just nAddr -> do
|
||||
return $
|
||||
NewAddrResponse
|
||||
(callId req)
|
||||
(toZcashAddressAPI nAddr)
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
maxAddr <-
|
||||
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||
newAddr <-
|
||||
liftIO $
|
||||
createCustomWalletAddress
|
||||
n
|
||||
(maxAddr + 1)
|
||||
net
|
||||
External
|
||||
acc'
|
||||
s
|
||||
t
|
||||
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||
case dbAddr of
|
||||
Just nAddr -> do
|
||||
return $
|
||||
NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32006) "Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetOperationStatus ->
|
||||
|
@ -788,89 +682,6 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
ErrorResponse (callId req) (-32009) "Operation ID not found"
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
SendMany ->
|
||||
case parameters req of
|
||||
SendParams a ns p -> do
|
||||
let dbPath = w_dbPath state
|
||||
let zHost = w_host state
|
||||
let zPort = w_port state
|
||||
let znet = w_network state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
opid <- liftIO nextRandom
|
||||
startTime <- liftIO getCurrentTime
|
||||
opkey <-
|
||||
liftIO $
|
||||
saveOperation pool $
|
||||
Operation
|
||||
(ZenithUuid opid)
|
||||
startTime
|
||||
Nothing
|
||||
Processing
|
||||
Nothing
|
||||
case opkey of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32010) "Internal Error"
|
||||
Just opkey' -> do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
bl <-
|
||||
liftIO $
|
||||
getLastSyncBlock
|
||||
pool
|
||||
(zcashAccountWalletId $ entityVal acc')
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
(entityKey acc')
|
||||
bl
|
||||
ns
|
||||
p
|
||||
case res of
|
||||
Left e ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e
|
||||
Right rawTx -> do
|
||||
zebraRes <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ H.toText rawTx]
|
||||
case zebraRes of
|
||||
Left e1 ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e1
|
||||
Right txId ->
|
||||
finalizeOperation pool opkey' Successful $
|
||||
"Tx ID: " <> H.toText txId
|
||||
return $ SendResponse (callId req) opid
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
|
||||
authenticate :: Config -> BasicAuthCheck Bool
|
||||
authenticate config = BasicAuthCheck check
|
||||
|
@ -883,71 +694,3 @@ authenticate config = BasicAuthCheck check
|
|||
packRpcResponse :: ToJSON a => T.Text -> a -> Value
|
||||
packRpcResponse i x =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
|
||||
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
|
||||
scanZebra dbPath zHost zPort net = do
|
||||
bStatus <- checkBlockChain zHost zPort
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- getMinBirthdayHeight pool $ ZcashNetDB net
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
|
||||
unless (sb > zgb_blocks bStatus || sb < 1) $ do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
unless (null bList) $ do
|
||||
_ <- startSync pool
|
||||
mapM_ (processBlock pool) bList
|
||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- completeSync pool Failed
|
||||
return ()
|
||||
Right _ -> do
|
||||
wals <- getWallets pool net
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
|
||||
runNoLoggingT $
|
||||
mapM_
|
||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||
wals
|
||||
_ <- completeSync pool Successful
|
||||
return ()
|
||||
where
|
||||
processBlock :: ConnectionPool -> Int -> IO ()
|
||||
processBlock pool bl = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
|
||||
case r of
|
||||
Left _ -> completeSync pool Failed
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
|
||||
case r2 of
|
||||
Left _ -> completeSync pool Failed
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
saveBlock pool $
|
||||
ZcashBlock
|
||||
(fromIntegral $ bl_height blk)
|
||||
(HexStringDB $ bl_hash blk)
|
||||
(fromIntegral $ bl_confirmations blk)
|
||||
blockTime
|
||||
(ZcashNetDB net)
|
||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||
|
|
|
@ -6,13 +6,7 @@ import Control.Concurrent.Async (concurrently_, withAsync)
|
|||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger
|
||||
( NoLoggingT
|
||||
, logErrorN
|
||||
, logInfoN
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import qualified Data.Text as T
|
||||
|
@ -31,33 +25,21 @@ import ZcashHaskell.Types
|
|||
, fromRawTBundle
|
||||
)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
|
||||
import Zenith.Core (checkBlockChain, syncWallet)
|
||||
import Zenith.DB
|
||||
( ZcashBlock(..)
|
||||
, ZcashBlockId
|
||||
, clearWalletData
|
||||
( clearWalletData
|
||||
, clearWalletTransactions
|
||||
, completeSync
|
||||
, getBlock
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
, getUnconfirmedBlocks
|
||||
, getWallets
|
||||
, initDb
|
||||
, initPool
|
||||
, saveBlock
|
||||
, saveConfs
|
||||
, saveTransaction
|
||||
, startSync
|
||||
, updateWalletSync
|
||||
, upgradeQrTable
|
||||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, HexStringDB(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
import Zenith.Types (Config(..), ZcashNetDB(..))
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
||||
-- | 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
|
||||
let znet = ZcashNetDB $ zgb_net bStatus
|
||||
pool1 <- runNoLoggingT $ initPool dbFilePath
|
||||
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
|
||||
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
|
||||
_ <- initDb dbFilePath
|
||||
upgradeQrTable pool1
|
||||
pool2 <- runNoLoggingT $ initPool dbFilePath
|
||||
pool3 <- runNoLoggingT $ initPool dbFilePath
|
||||
clearWalletTransactions pool1
|
||||
clearWalletData pool1
|
||||
_ <- startSync pool1
|
||||
dbBlock <- getMaxBlock pool1 znet
|
||||
b <- liftIO $ getMinBirthdayHeight pool1 znet
|
||||
b <- liftIO $ getMinBirthdayHeight pool1
|
||||
let sb = max dbBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
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 pool3 pg3 znet) bl3-}
|
||||
print "Please wait..."
|
||||
_ <- completeSync pool1 Successful
|
||||
_ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
|
||||
print "Rescan complete"
|
||||
|
||||
-- | Function to process a raw block and extract the transaction information
|
||||
|
@ -129,9 +106,7 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
@ -141,31 +116,31 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e2
|
||||
Left e2 -> liftIO $ throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
saveBlock pool $
|
||||
ZcashBlock
|
||||
(fromIntegral $ bl_height blk)
|
||||
(HexStringDB $ bl_hash blk)
|
||||
(fromIntegral $ bl_confirmations blk)
|
||||
blockTime
|
||||
net
|
||||
mapM_ (processTx host port bi pool) $ bl_txs blk
|
||||
mapM_ (processTx host port blockTime pool net) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
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
|
||||
processTx ::
|
||||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> ZcashBlockId -- ^ Block ID
|
||||
-> Int -- ^ Block time
|
||||
-> ConnectionPool -- ^ DB file path
|
||||
-> ZcashNetDB -- ^ the network
|
||||
-> HexString -- ^ transaction id
|
||||
-> IO ()
|
||||
processTx host port bt pool t = do
|
||||
processTx host port bt pool net t = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
|
@ -174,16 +149,14 @@ processTx host port bt pool t = do
|
|||
"getrawtransaction"
|
||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right rawTx -> do
|
||||
case readZebraTransaction (ztr_hex rawTx) of
|
||||
Nothing -> return ()
|
||||
Just rzt -> do
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
saveTransaction pool bt $
|
||||
saveTransaction pool bt net $
|
||||
Transaction
|
||||
t
|
||||
(ztr_blockheight rawTx)
|
||||
|
@ -230,7 +203,6 @@ clearSync config = do
|
|||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
x <- initDb dbPath
|
||||
_ <- upgradeQrTable pool
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
|
@ -239,36 +211,5 @@ clearSync config = do
|
|||
w <- getWallets pool $ zgb_net chainInfo
|
||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
||||
r <- runNoLoggingT $ mapM (syncWallet config) w'
|
||||
r <- mapM (syncWallet config) w'
|
||||
liftIO $ print r
|
||||
|
||||
-- | Detect chain re-orgs
|
||||
checkIntegrity ::
|
||||
T.Text -- ^ Database path
|
||||
-> T.Text -- ^ Zebra host
|
||||
-> Int -- ^ Zebra port
|
||||
-> ZcashNet -- ^ the network to scan
|
||||
-> Int -- ^ The block to start the check
|
||||
-> Int -- ^ depth
|
||||
-> IO Int
|
||||
checkIntegrity dbP zHost zPort znet b d =
|
||||
if b < 1
|
||||
then return 1
|
||||
else do
|
||||
r <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right blk -> do
|
||||
pool <- runNoLoggingT $ initPool dbP
|
||||
dbBlk <- getBlock pool b $ ZcashNetDB znet
|
||||
case dbBlk of
|
||||
Nothing -> return 1
|
||||
Just dbBlk' ->
|
||||
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
|
||||
then return b
|
||||
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)
|
||||
|
|
|
@ -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
|
|
@ -17,30 +17,19 @@ import qualified Data.ByteString.Char8 as C
|
|||
import Data.HexString
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Scientific (Scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import qualified Data.UUID as U
|
||||
import Database.Persist.TH
|
||||
import GHC.Generics
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Sapling (encodeSaplingAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( encodeExchangeAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, OrchardSpendingKey(..)
|
||||
( OrchardSpendingKey(..)
|
||||
, Phrase(..)
|
||||
, Rseed(..)
|
||||
, SaplingAddress(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, Scope(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentSpendingKey
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
|
||||
|
@ -115,10 +104,10 @@ data Config = Config
|
|||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
data ZcashPool
|
||||
= TransparentPool
|
||||
| SproutPool
|
||||
| SaplingPool
|
||||
| OrchardPool
|
||||
= Transparent
|
||||
| Sprout
|
||||
| Sapling
|
||||
| Orchard
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
derivePersistField "ZcashPool"
|
||||
|
@ -126,18 +115,18 @@ derivePersistField "ZcashPool"
|
|||
instance ToJSON ZcashPool where
|
||||
toJSON zp =
|
||||
case zp of
|
||||
TransparentPool -> Data.Aeson.String "p2pkh"
|
||||
SproutPool -> Data.Aeson.String "sprout"
|
||||
SaplingPool -> Data.Aeson.String "sapling"
|
||||
OrchardPool -> Data.Aeson.String "orchard"
|
||||
Transparent -> Data.Aeson.String "p2pkh"
|
||||
Sprout -> Data.Aeson.String "sprout"
|
||||
Sapling -> Data.Aeson.String "sapling"
|
||||
Orchard -> Data.Aeson.String "orchard"
|
||||
|
||||
instance FromJSON ZcashPool where
|
||||
parseJSON =
|
||||
withText "ZcashPool" $ \case
|
||||
"p2pkh" -> return TransparentPool
|
||||
"sprout" -> return SproutPool
|
||||
"sapling" -> return SaplingPool
|
||||
"orchard" -> return OrchardPool
|
||||
"p2pkh" -> return Transparent
|
||||
"sprout" -> return Sprout
|
||||
"sapling" -> return Sapling
|
||||
"orchard" -> return Orchard
|
||||
_ -> fail "Not a known Zcash pool"
|
||||
|
||||
newtype ZenithUuid = ZenithUuid
|
||||
|
@ -210,64 +199,13 @@ $(deriveJSON defaultOptions ''ZenithStatus)
|
|||
derivePersistField "ZenithStatus"
|
||||
|
||||
data PrivacyPolicy
|
||||
= None
|
||||
| Low
|
||||
= Full
|
||||
| Medium
|
||||
| Full
|
||||
deriving (Eq, Show, Read, Ord)
|
||||
| Low
|
||||
| None
|
||||
|
||||
$(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`
|
||||
-- | Type for modeling the tree state response
|
||||
data ZebraTreeInfo = ZebraTreeInfo
|
||||
|
@ -359,8 +297,7 @@ instance FromJSON AddressGroup where
|
|||
Nothing -> return []
|
||||
Just x -> do
|
||||
x' <- x .:? "addresses"
|
||||
return $
|
||||
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
|
||||
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
|
||||
processSapling k s2 =
|
||||
case k of
|
||||
Nothing -> return []
|
||||
|
@ -368,7 +305,7 @@ instance FromJSON AddressGroup where
|
|||
where processOneSapling sx =
|
||||
withObject "Sapling" $ \oS -> do
|
||||
oS' <- oS .: "addresses"
|
||||
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
|
||||
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
|
||||
processUnified u =
|
||||
case u of
|
||||
Nothing -> return []
|
||||
|
|
|
@ -3,38 +3,30 @@
|
|||
module Zenith.Utils where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Char (isAlphaNum, isSpace)
|
||||
import Data.Functor (void)
|
||||
import Data.Maybe
|
||||
import Data.Ord (clamp)
|
||||
import Data.Scientific (Scientific(..), scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Char (isAlphaNum, isSpace)
|
||||
import System.Directory
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Regex.Posix
|
||||
import ZcashHaskell.Orchard
|
||||
( encodeUnifiedAddress
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, SaplingAddress(..)
|
||||
( SaplingAddress(..)
|
||||
, TransparentAddress(..)
|
||||
, UnifiedAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
import Zenith.Types
|
||||
( AddressGroup(..)
|
||||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashAddress(..)
|
||||
, ZcashPool(..)
|
||||
|
@ -79,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
|||
-- | Helper function to validate potential Zcash addresses
|
||||
validateAddress :: T.Text -> Maybe ZcashPool
|
||||
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||
| tReg = Just TransparentPool
|
||||
| sReg && chkS = Just SaplingPool
|
||||
| uReg && chk = Just OrchardPool
|
||||
| tReg = Just Transparent
|
||||
| sReg && chkS = Just Sapling
|
||||
| uReg && chk = Just Orchard
|
||||
| otherwise = Nothing
|
||||
where
|
||||
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
||||
|
@ -118,7 +110,7 @@ validBarValue :: Float -> Float
|
|||
validBarValue = clamp (0, 1)
|
||||
|
||||
isRecipientValid :: T.Text -> Bool
|
||||
isRecipientValid a = do
|
||||
isRecipientValid a =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
|
@ -130,80 +122,8 @@ isRecipientValid a = do
|
|||
Just _a4 -> True
|
||||
Nothing -> False)
|
||||
|
||||
isUnifiedAddressValid :: T.Text -> Bool
|
||||
isUnifiedAddressValid ua =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||
Just _a1 -> True
|
||||
Nothing -> False
|
||||
|
||||
isSaplingAddressValid :: T.Text -> Bool
|
||||
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
||||
|
||||
isTransparentAddressValid :: T.Text -> Bool
|
||||
isTransparentAddressValid ta =
|
||||
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
||||
Just _a3 -> True
|
||||
Nothing -> False
|
||||
|
||||
isExchangeAddressValid :: T.Text -> Bool
|
||||
isExchangeAddressValid xa =
|
||||
case decodeExchangeAddress (E.encodeUtf8 xa) of
|
||||
Just _a4 -> True
|
||||
Nothing -> False
|
||||
|
||||
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
||||
isRecipientValidGUI p a = do
|
||||
let adr = parseAddress (E.encodeUtf8 a)
|
||||
case p of
|
||||
Full ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Medium ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Low ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
Transparent ta -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
None ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Transparent ta -> True
|
||||
Exchange ea -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
|
||||
isZecAddressValid :: T.Text -> Bool
|
||||
isZecAddressValid a = do
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
isValidShieldedAddress (E.encodeUtf8 a) ||
|
||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||
Just _a4 -> True
|
||||
Nothing -> False)
|
||||
|
||||
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
||||
parseAddressUA a znet =
|
||||
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
||||
parseAddress a znet =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just a1 -> Just a1
|
||||
Nothing ->
|
||||
|
@ -217,16 +137,16 @@ parseAddressUA a znet =
|
|||
Nothing -> Nothing
|
||||
|
||||
isValidContent :: String -> Bool
|
||||
isValidContent [] = False -- an empty string is invalid
|
||||
isValidContent [] = False -- an empty string is invalid
|
||||
isValidContent (x:xs)
|
||||
| not (isAlphaNum x) = False -- string must start with an alphanumeric character
|
||||
| otherwise = allValidChars xs -- process the rest of the string
|
||||
| not (isAlphaNum x ) = False -- string must start with an alphanumeric character
|
||||
| otherwise = allValidChars xs -- process the rest of the string
|
||||
where
|
||||
allValidChars :: String -> Bool
|
||||
allValidChars [] = True -- if we got here, string is valid
|
||||
allValidChars [] = True -- if we got here, string is valid
|
||||
allValidChars (y:ys)
|
||||
| isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
|
||||
| otherwise = False -- found an invalid character, return false
|
||||
| otherwise = False -- found an invalid character, return false
|
||||
|
||||
isValidString :: T.Text -> Bool
|
||||
isValidString c = do
|
||||
|
@ -235,16 +155,10 @@ isValidString c = do
|
|||
|
||||
padWithZero :: Int -> String -> String
|
||||
padWithZero n s
|
||||
| (length s) >= n = s
|
||||
| otherwise = padWithZero n ("0" ++ s)
|
||||
| (length s) >= n = s
|
||||
| otherwise = padWithZero n ("0" ++ s)
|
||||
|
||||
isEmpty :: [a] -> Bool
|
||||
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
|
||||
|
|
|
@ -123,10 +123,9 @@ sendTx user pwd fromAddy toAddy amount memo = do
|
|||
if source fromAddy /= ImportedWatchOnly
|
||||
then do
|
||||
let privacyPolicy
|
||||
| valAdd == Just TransparentPool = "AllowRevealedRecipients"
|
||||
| valAdd == Just Transparent = "AllowRevealedRecipients"
|
||||
| isNothing (account fromAddy) &&
|
||||
elem TransparentPool (pool fromAddy) =
|
||||
"AllowRevealedSenders"
|
||||
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
|
||||
| otherwise = "AllowRevealedAmounts"
|
||||
let pd =
|
||||
case memo of
|
||||
|
@ -302,7 +301,7 @@ sendWithUri user pwd fromAddy uri repTo = do
|
|||
let addType = validateAddress $ T.pack parsedAddress
|
||||
case addType of
|
||||
Nothing -> putStrLn " Invalid address"
|
||||
Just TransparentPool -> do
|
||||
Just Transparent -> do
|
||||
putStrLn $ " Address is valid: " ++ parsedAddress
|
||||
case (readMaybe parsedAmount :: Maybe Double) of
|
||||
Nothing -> putStrLn " Invalid amount."
|
||||
|
|
|
@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
|
|||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Configurator
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
|
@ -18,7 +18,7 @@ import Servant
|
|||
import System.Directory
|
||||
import Test.HUnit hiding (State)
|
||||
import Test.Hspec
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Types
|
||||
( ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
|
@ -39,9 +39,6 @@ import Zenith.RPC
|
|||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
|
@ -575,107 +572,6 @@ main = do
|
|||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
|
||||
Right _ -> assertFailure "unexpected response"
|
||||
describe "Send tx" $ do
|
||||
describe "sendmany" $ do
|
||||
it "bad credentials" $ do
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
"baduser"
|
||||
"idontknow"
|
||||
SendMany
|
||||
BlankParams
|
||||
res `shouldBe` Left "Invalid credentials"
|
||||
describe "correct credentials" $ do
|
||||
it "invalid account" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
17
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "A cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
|
||||
it "valid account, empty notes" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams 1 [] Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||
it "valid account, single output" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
1
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
5.0
|
||||
(Just "A cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||
it "valid account, multiple outputs" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
SendMany
|
||||
(SendParams
|
||||
1
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
5.0
|
||||
(Just "A cool memo")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
1.0
|
||||
(Just "Not so cool memo")
|
||||
]
|
||||
Full)
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||
|
||||
startAPI :: Config -> IO ()
|
||||
startAPI config = do
|
||||
|
|
1006
test/Spec.hs
1006
test/Spec.hs
File diff suppressed because it is too large
Load diff
|
@ -1 +1 @@
|
|||
Subproject commit d45bd7dcf3c3cf4e893900a1774d24b14bf56591
|
||||
Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c
|
|
@ -132,7 +132,6 @@
|
|||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/DuplicateName" }
|
||||
]
|
||||
},
|
||||
|
@ -229,7 +228,6 @@
|
|||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/DuplicateName" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/InvalidWallet" }
|
||||
]
|
||||
},
|
||||
|
@ -446,7 +444,6 @@
|
|||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/InvalidAccount" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/DuplicateName" }
|
||||
]
|
||||
},
|
||||
|
@ -596,11 +593,10 @@
|
|||
{
|
||||
"name": "sendmany",
|
||||
"summary": "Send transaction(s)",
|
||||
"description": "Send one transaction by specifying the source account, the privacy policy (optional, default 'Full') and an array of proposed outputs. Each output needs a recipient address, an amount and an optional shielded memo.",
|
||||
"tags": [],
|
||||
"description": "Send one or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
|
||||
"tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
|
||||
"params": [
|
||||
{ "$ref": "#/components/contentDescriptors/AccountId"},
|
||||
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
|
||||
{ "$ref": "#/components/contentDescriptors/TxRequestArray"}
|
||||
],
|
||||
"paramStructure": "by-position",
|
||||
|
@ -614,19 +610,14 @@
|
|||
"examples": [
|
||||
{
|
||||
"name": "Send a transaction",
|
||||
"summary": "Send a transaction",
|
||||
"description": "Send a transaction with one output",
|
||||
"summary": "Send one transaction",
|
||||
"description": "Send a single transaction",
|
||||
"params": [
|
||||
{
|
||||
"name": "Account index",
|
||||
"summary": "The index for the account to use",
|
||||
"value": "1"
|
||||
},
|
||||
{
|
||||
"name": "Privacy Policy",
|
||||
"summary": "The selected privacy policy",
|
||||
"value": "Full"
|
||||
},
|
||||
{
|
||||
"name": "Transaction request",
|
||||
"summary": "The transaction to attempt",
|
||||
|
@ -649,7 +640,7 @@
|
|||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/ZenithBusy" },
|
||||
{ "$ref": "#/components/errors/InvalidRecipient" },
|
||||
{ "$ref": "#/components/errors/InvalidAccount" }
|
||||
]
|
||||
},
|
||||
|
@ -745,16 +736,6 @@
|
|||
"type": "array",
|
||||
"items": { "$ref": "#/components/schemas/TxRequest"}
|
||||
}
|
||||
},
|
||||
"PrivacyPolicy": {
|
||||
"name": "Privacy Policy",
|
||||
"summary": "The chosen privacy policy to use for the transaction",
|
||||
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
|
||||
"required": false,
|
||||
"schema": {
|
||||
"type": "string",
|
||||
"enum": ["None", "Low", "Medium", "Full"]
|
||||
}
|
||||
}
|
||||
},
|
||||
"schemas": {
|
||||
|
@ -833,7 +814,8 @@
|
|||
"properties": {
|
||||
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
|
||||
"amount": { "type": "number", "description": "The amount to send in ZEC"},
|
||||
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
|
||||
"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": {
|
||||
"code": -32011,
|
||||
"message": "The provided recipient address is not valid."
|
||||
},
|
||||
"ZenithBusy": {
|
||||
"code": -32012,
|
||||
"message": "The Zenith server is syncing, please try again later."
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
@ -36,7 +36,6 @@ library
|
|||
Zenith.Zcashd
|
||||
Zenith.Scanner
|
||||
Zenith.RPC
|
||||
Zenith.Tree
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
|
@ -50,7 +49,6 @@ library
|
|||
, base >=4.12 && <5
|
||||
, base64-bytestring
|
||||
, binary
|
||||
, borsh
|
||||
, brick
|
||||
, bytestring
|
||||
, configurator
|
||||
|
@ -60,7 +58,6 @@ library
|
|||
, exceptions
|
||||
, filepath
|
||||
, ghc
|
||||
, generics-sop
|
||||
, haskoin-core
|
||||
, hexstring
|
||||
, http-client
|
||||
|
@ -127,12 +124,9 @@ executable zenithserver
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, configurator
|
||||
, monad-logger
|
||||
, wai-extra
|
||||
, warp
|
||||
, servant-server
|
||||
, text
|
||||
, unix
|
||||
, zcash-haskell
|
||||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
|
@ -147,11 +141,8 @@ test-suite zenith-tests
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, aeson
|
||||
, configurator
|
||||
, monad-logger
|
||||
, borsh
|
||||
, aeson
|
||||
, data-default
|
||||
, sort
|
||||
, text
|
||||
|
|
Loading…
Reference in a new issue