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