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

Compare commits

base: Vergara_Tech:zrpc-docker
Branches Tags
Vergara_Tech:master
Vergara_Tech:rav001
Vergara_Tech:rvv001
Vergara_Tech:zrpc-docker
Vergara_Tech:rvv041
Vergara_Tech:milestone3
Vergara_Tech:zenith-install
Vergara_Tech:milestone2
Vergara_Tech:dev041
Vergara_Tech:legacy
Vergara_Tech:0.6.0.0-beta
Vergara_Tech:0.5.3.1-beta
Vergara_Tech:0.5.3.0-beta
Vergara_Tech:0.5.2.0-beta
Vergara_Tech:0.5.1.0-beta.1
Vergara_Tech:0.5.1.0-beta
Vergara_Tech:0.4.0
Vergara_Tech:0.3.4
Vergara_Tech:0.3.2
Vergara_Tech:0.3.1.0
Vergara_Tech:0.3.0.0
Vergara_Tech:0.2.0.0
Vergara_Tech:0.1.0.0
..
compare: Vergara_Tech:master
Branches Tags
Vergara_Tech:rav001
Vergara_Tech:rvv001
Vergara_Tech:zrpc-docker
Vergara_Tech:rvv041
Vergara_Tech:milestone3
Vergara_Tech:zenith-install
Vergara_Tech:master
Vergara_Tech:milestone2
Vergara_Tech:dev041
Vergara_Tech:legacy
Vergara_Tech:0.6.0.0-beta
Vergara_Tech:0.5.3.1-beta
Vergara_Tech:0.5.3.0-beta
Vergara_Tech:0.5.2.0-beta
Vergara_Tech:0.5.1.0-beta.1
Vergara_Tech:0.5.1.0-beta
Vergara_Tech:0.4.0
Vergara_Tech:0.3.4
Vergara_Tech:0.3.2
Vergara_Tech:0.3.1.0
Vergara_Tech:0.3.0.0
Vergara_Tech:0.2.0.0
Vergara_Tech:0.1.0.0

No commits in common. "zrpc-docker" and "master" have entirely different histories.
zrpc-docke ... master

36 changed files with 486 additions and 4352 deletions
Show stats Expand all files Collapse all files

2
.gitignore vendored
View file

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

20
CHANGELOG.md
View file

@ -5,26 +5,6 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [Unreleased]
### Added
- RPC module
- OpenRPC specification
- `listwallets` RPC method
- `listaccounts` RPC method
- `listaddresses` RPC method
- `listreceived` RPC method
- `getbalance` RPC method
- `getnewwallet` RPC method
- `getnewaccount` RPC method
- `getnewaddress` RPC method
- `getoperationstatus` RPC method
### Changed
- Detection of changes in database schema for automatic re-scan
## [0.6.0.0-beta]
### Added

16
app/Main.hs
View file

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

54
app/Server.hs
View file

@ -1,54 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Server where
import Control.Exception (throwIO, try)
import Control.Monad (when)
import Data.Configurator
import Network.Wai.Handler.Warp (run)
import Servant
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (initDb)
import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
import Zenith.Scanner (rescanZebra)
import Zenith.Types (Config(..))
main :: IO ()
main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"]
dbFileName <- require config "dbFileName"
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
nodePort <- require config "nodePort"
let myConfig = Config dbFileName zebraHost zebraPort nodeUser nodePwd nodePort
let ctx = authenticate myConfig :. EmptyContext
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
case w of
Right zebra -> do
bc <-
try $ checkBlockChain zebraHost zebraPort :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb dbFileName
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zebraHost zebraPort dbFileName
let myState =
State
(zgb_net chainInfo)
zebraHost
zebraPort
dbFileName
(zgi_build zebra)
(zgb_blocks chainInfo)
run nodePort $
serveWithContext
(Proxy :: Proxy ZenithRPC)
ctx
(zenithServer myState)

2
app/ZenScan.hs
View file

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

41
cabal.project.freeze
View file

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

48
docker_files/Dockerfile
View file

@ -1,48 +0,0 @@
# =====================================================
# 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
View file

Binary file not shown.

BIN
docker_files/Downloads/libc-dev-bin_2.38-1ubuntu6_amd64.deb
View file

Binary file not shown.

BIN
docker_files/Downloads/libc6_2.38-1ubuntu6_amd64.deb
View file

Binary file not shown.

6
docker_files/bin/startrpc
View file

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

BIN
docker_files/bin/zenithserver
View file

Binary file not shown.

43
docker_files/cfg/runzenithrpc
View file

@ -1,43 +0,0 @@
#!/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
View file

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

59
docker_files/dockerpkg
View file

@ -1,59 +0,0 @@
#!/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
View file

Binary file not shown.

BIN
docker_files/lib/sapling-output.params
View file

Binary file not shown.

BIN
docker_files/lib/sapling-spend.params
View file

Binary file not shown.

100
docker_files/scripts/bash_rc_adm
View file

@ -1,100 +0,0 @@
# ~/.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
View file

@ -1,118 +0,0 @@
# ~/.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
View file

@ -1,8 +0,0 @@
#!/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
View file

@ -1,70 +0,0 @@
#!/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

183
src/Zenith/CLI.hs
View file

@ -10,8 +10,10 @@ import qualified Brick.BChan as BC
import qualified Brick.Focus as F
import Brick.Forms
( Form(..)
, FormFieldState
, (@@=)
, allFieldsValid
, editShowableField
, editShowableFieldWithValidate
, editTextField
, focusedFormInputAttr
@ -40,6 +42,7 @@ import Brick.Widgets.Core
, joinBorders
, padAll
, padBottom
, padLeft
, padTop
, setAvailableSize
, str
@ -60,10 +63,10 @@ import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, void, when)
import Control.Exception (catch, throw, throwIO, try)
import Control.Monad (forever, void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Data.HexString (HexString(..), toText)
import Data.Maybe
@ -80,15 +83,19 @@ import Lens.Micro.Mtl
import Lens.Micro.TH
import System.Hclip
import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
import Zenith.DB
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
import Zenith.Scanner (processTx, updateConfs)
import Zenith.Types
( Config(..)
, PhraseDB(..)
@ -715,12 +722,12 @@ abSelAttr = A.attrName "abselected"
abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar"
scanZebra ::
T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
scanZebra dbP zHost zPort b eChan znet = do
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
scanZebra dbP zHost zPort b eChan = do
_ <- liftIO $ initDb dbP
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP
dbBlock <- getMaxBlock pool $ ZcashNetDB znet
dbBlock <- runNoLoggingT $ getMaxBlock pool
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 ->
@ -765,7 +772,7 @@ scanZebra dbP zHost zPort b eChan znet = do
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
Right hb -> do
let blockTime = getBlockTime hb
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
bl_txs $ addTime blk blockTime
liftIO $ BC.writeBChan eChan $ TickVal step
addTime :: BlockResponse -> Int -> BlockResponse
@ -820,13 +827,7 @@ appEvent (BT.AppEvent t) = do
_ <-
liftIO $
syncWallet
(Config
(s ^. dbPath)
(s ^. zebraHost)
(s ^. zebraPort)
"user"
"pwd"
8080)
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
@ -861,7 +862,6 @@ appEvent (BT.AppEvent t) = do
(s ^. zebraPort)
sBlock
(s ^. eventDispatch)
(s ^. network)
BT.modify $ set timer 0
return ()
else BT.modify $ set timer $ 1 + s ^. timer
@ -1363,82 +1363,75 @@ runZenithTUI config = do
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb dbFilePath
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra host port dbFilePath
walList <- getWallets pool $ zgb_net chainInfo
accList <-
initDb dbFilePath
walList <- getWallets pool $ zgb_net chainInfo
accList <-
if not (null walList)
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
else return []
addrList <-
if not (null accList)
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
else return []
txList <-
if not (null addrList)
then getUserTx pool $ entityKey $ head addrList
else return []
let block =
if not (null walList)
then runNoLoggingT $
getAccounts pool $ entityKey $ head walList
else return []
addrList <-
if not (null accList)
then runNoLoggingT $
getAddresses pool $ entityKey $ head accList
else return []
txList <-
if not (null addrList)
then getUserTx pool $ entityKey $ head addrList
else return []
let block =
if not (null walList)
then zcashWalletLastSync $ entityVal $ head walList
else 0
abookList <- getAdrBook pool $ zgb_net chainInfo
bal <-
if not (null accList)
then getBalance pool $ entityKey $ head accList
else return 0
uBal <-
if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10
_ <-
forkIO $
forever $ do
BC.writeBChan eventChan (TickVal 0.0)
threadDelay 1000000
let buildVty = VC.mkVty V.defaultConfig
initialVty <- buildVty
void $
M.customMain initialVty buildVty (Just eventChan) theApp $
State
(zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0)
(L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++
(T.unpack . zgi_build) zebra ++
" on port " ++ show port ++ ".")
False
(if null walList
then WName
else Blank)
True
(mkInputForm $ DialogInput "Main")
(F.focusRing [AList, TList])
(zgb_blocks chainInfo)
dbFilePath
host
port
MsgDisplay
block
bal
1.0
eventChan
0
(mkSendForm 0 $ SendInput "" 0.0 "")
(L.list ABList (Vec.fromList abookList) 1)
(mkNewABForm (AdrBookEntry "" ""))
""
Nothing
uBal
Left _e -> do
then zcashWalletLastSync $ entityVal $ head walList
else 0
abookList <- getAdrBook pool $ zgb_net chainInfo
bal <-
if not (null accList)
then getBalance pool $ entityKey $ head accList
else return 0
uBal <-
if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10
_ <-
forkIO $
forever $ do
BC.writeBChan eventChan (TickVal 0.0)
threadDelay 1000000
let buildVty = VC.mkVty V.defaultConfig
initialVty <- buildVty
void $
M.customMain initialVty buildVty (Just eventChan) theApp $
State
(zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0)
(L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
False
(if null walList
then WName
else Blank)
True
(mkInputForm $ DialogInput "Main")
(F.focusRing [AList, TList])
(zgb_blocks chainInfo)
dbFilePath
host
port
MsgDisplay
block
bal
1.0
eventChan
0
(mkSendForm 0 $ SendInput "" 0.0 "")
(L.list ABList (Vec.fromList abookList) 1)
(mkNewABForm (AdrBookEntry "" ""))
""
Nothing
uBal
Left e -> do
print $
"No Zebra node available on port " <>
show port <> ". Check your configuration."

349
src/Zenith/Core.hs
View file

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

561
src/Zenith/DB.hs
View file

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

539
src/Zenith/GUI.hs
View file

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

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

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

696
src/Zenith/RPC.hs
View file

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

131
src/Zenith/Scanner.hs
View file

@ -2,22 +2,29 @@
module Zenith.Scanner where
import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try)
import Control.Monad (when)
import qualified Control.Monad.Catch as CM (try)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
import Control.Monad.Logger
( LoggingT
, NoLoggingT
, logErrorN
, logInfoN
, runNoLoggingT
)
import Data.Aeson
import Data.HexString
import Data.Maybe
import qualified Data.Text as T
import Data.Time (getCurrentTime)
import Database.Persist.Sqlite
import GHC.Utils.Monad (concatMapM)
import Lens.Micro ((&), (.~), (^.), set)
import System.Console.AsciiProgress
import ZcashHaskell.Types
( BlockResponse(..)
, RawZebraTx(..)
, Transaction(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
, ZebraTxResponse(..)
, fromRawOBundle
@ -25,68 +32,59 @@ import ZcashHaskell.Types
, fromRawTBundle
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain, syncWallet)
import Zenith.Core (checkBlockChain)
import Zenith.DB
( clearWalletData
, clearWalletTransactions
, getMaxBlock
, getMinBirthdayHeight
( getMaxBlock
, getUnconfirmedBlocks
, getWallets
, initDb
, initPool
, saveConfs
, saveTransaction
, updateWalletSync
)
import Zenith.Types (Config(..), ZcashNetDB(..))
import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
rescanZebra ::
T.Text -- ^ Host
scanZebra ::
Int -- ^ Starting block
-> T.Text -- ^ Host
-> Int -- ^ Port
-> T.Text -- ^ Path to database file
-> IO ()
rescanZebra host port dbFilePath = do
-> NoLoggingT IO ()
scanZebra b host port dbFilePath = do
_ <- liftIO $ initDb dbFilePath
startTime <- liftIO getCurrentTime
logInfoN $ "Started sync: " <> T.pack (show startTime)
bc <-
try $ checkBlockChain host port :: IO
liftIO $ try $ checkBlockChain host port :: NoLoggingT
IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e -> print e
Left e -> logErrorN $ T.pack (show e)
Right bStatus -> do
let znet = ZcashNetDB $ zgb_net bStatus
pool1 <- runNoLoggingT $ initPool dbFilePath
pool2 <- runNoLoggingT $ initPool dbFilePath
pool3 <- runNoLoggingT $ initPool dbFilePath
clearWalletTransactions pool1
clearWalletData pool1
dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1
let dbInfo =
mkSqliteConnectionInfo dbFilePath & extraPragmas .~
["read_uncommited = true"]
pool <- createSqlitePoolFromInfo dbInfo 5
dbBlock <- getMaxBlock pool
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then liftIO $ throwIO $ userError "Invalid starting block for scan"
else do
print $
"Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
let bList = [sb .. (zgb_blocks bStatus)]
{-
let batch = length bList `div` 3
let bl1 = take batch bList
let bl2 = take batch $ drop batch bList
let bl3 = drop (2 * batch) bList
-}
_ <-
displayConsoleRegions $ do
pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
{-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
{-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
mapM_ (processBlock host port pool1 pg1 znet) bList
{-`concurrently_`-}
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..."
print "Rescan complete"
liftIO $
print $
"Scanning from " ++
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
displayConsoleRegions $ do
pg <-
liftIO $
newProgressBar def {pgTotal = fromIntegral $ length bList}
txList <-
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
IO
(Either IOError ())
case txList of
Left e1 -> logErrorN $ T.pack (show e1)
Right txList' -> logInfoN "Finished scan"
-- | Function to process a raw block and extract the transaction information
processBlock ::
@ -94,10 +92,9 @@ processBlock ::
-> Int -- ^ Port for `zebrad`
-> ConnectionPool -- ^ DB file path
-> ProgressBar -- ^ Progress bar
-> ZcashNetDB -- ^ the network
-> Int -- ^ The block number to process
-> IO ()
processBlock host port pool pg net b = do
-> NoLoggingT IO ()
processBlock host port pool pg b = do
r <-
liftIO $
makeZebraCall
@ -119,7 +116,7 @@ processBlock host port pool pg net b = do
Left e2 -> liftIO $ throwIO $ userError e2
Right hb -> do
let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime pool net) $
mapM_ (processTx host port blockTime pool) $
bl_txs $ addTime blk blockTime
liftIO $ tick pg
where
@ -137,10 +134,9 @@ processTx ::
-> Int -- ^ Port for `zebrad`
-> Int -- ^ Block time
-> ConnectionPool -- ^ DB file path
-> ZcashNetDB -- ^ the network
-> HexString -- ^ transaction id
-> IO ()
processTx host port bt pool net t = do
-> NoLoggingT IO ()
processTx host port bt pool t = do
r <-
liftIO $
makeZebraCall
@ -155,8 +151,7 @@ processTx host port bt pool net t = do
Nothing -> return ()
Just rzt -> do
_ <-
runNoLoggingT $
saveTransaction pool bt net $
saveTransaction pool bt $
Transaction
t
(ztr_blockheight rawTx)
@ -189,27 +184,3 @@ updateConfs host port pool = do
Left e -> throwIO $ userError e
Right blk -> do
saveConfs pool b $ fromInteger $ bl_confirmations blk
clearSync :: Config -> IO ()
clearSync config = do
let zHost = c_zebraHost config
let zPort = c_zebraPort config
let dbPath = c_dbPath config
pool <- runNoLoggingT $ initPool dbPath
bc <-
try $ checkBlockChain zHost zPort :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb dbPath
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zHost zPort dbPath
_ <- clearWalletTransactions pool
w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- mapM (syncWallet config) w'
liftIO $ print r

130
src/Zenith/Types.hs
View file

@ -10,17 +10,14 @@
module Zenith.Types where
import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.HexString
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U
import Database.Persist.TH
import GHC.Generics
import ZcashHaskell.Types
@ -45,9 +42,6 @@ newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet
} deriving newtype (Eq, Show, Read)
instance ToJSON ZcashNetDB where
toJSON (ZcashNetDB z) = toJSON z
derivePersistField "ZcashNetDB"
newtype UnifiedAddressDB = UnifiedAddressDB
@ -98,114 +92,8 @@ data Config = Config
{ c_dbPath :: !T.Text
, c_zebraHost :: !T.Text
, c_zebraPort :: !Int
, c_zenithUser :: !BS.ByteString
, c_zenithPwd :: !BS.ByteString
, c_zenithPort :: !Int
} deriving (Eq, Prelude.Show)
data ZcashPool
= Transparent
| Sprout
| Sapling
| Orchard
deriving (Show, Read, Eq)
derivePersistField "ZcashPool"
instance ToJSON ZcashPool where
toJSON zp =
case zp of
Transparent -> Data.Aeson.String "p2pkh"
Sprout -> Data.Aeson.String "sprout"
Sapling -> Data.Aeson.String "sapling"
Orchard -> Data.Aeson.String "orchard"
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return Transparent
"sprout" -> return Sprout
"sapling" -> return Sapling
"orchard" -> return Orchard
_ -> fail "Not a known Zcash pool"
newtype ZenithUuid = ZenithUuid
{ getUuid :: U.UUID
} deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
derivePersistField "ZenithUuid"
-- ** API types
data ZcashWalletAPI = ZcashWalletAPI
{ zw_index :: !Int
, zw_name :: !T.Text
, zw_network :: !ZcashNet
, zw_birthday :: !Int
, zw_lastSync :: !Int
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashWalletAPI)
data ZcashAccountAPI = ZcashAccountAPI
{ za_index :: !Int
, za_wallet :: !Int
, za_name :: !T.Text
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAccountAPI)
data ZcashAddressAPI = ZcashAddressAPI
{ zd_index :: !Int
, zd_account :: !Int
, zd_name :: !T.Text
, zd_ua :: !T.Text
, zd_legacy :: !(Maybe T.Text)
, zd_transparent :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAddressAPI)
data ZcashNoteAPI = ZcashNoteAPI
{ zn_txid :: !HexString
, zn_pool :: !ZcashPool
, zn_amount :: !Float
, zn_amountZats :: !Int64
, zn_memo :: !T.Text
, zn_confirmed :: !Bool
, zn_blockheight :: !Int
, zn_blocktime :: !Int
, zn_outindex :: !Int
, zn_change :: !Bool
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashNoteAPI)
data AccountBalance = AccountBalance
{ acb_transparent :: !Int64
, acb_sapling :: !Int64
, acb_orchard :: !Int64
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)
data ZenithStatus
= Processing
| Failed
| Successful
deriving (Eq, Prelude.Show, Read)
$(deriveJSON defaultOptions ''ZenithStatus)
derivePersistField "ZenithStatus"
data PrivacyPolicy
= Full
| Medium
| Low
| None
$(deriveJSON defaultOptions ''PrivacyPolicy)
-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo
@ -250,6 +138,24 @@ instance FromJSON AddressSource where
"mnemonic_seed" -> return MnemonicSeed
_ -> fail "Not a known address source"
data ZcashPool
= Transparent
| Sprout
| Sapling
| Orchard
deriving (Show, Read, Eq, Generic, ToJSON)
derivePersistField "ZcashPool"
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return Transparent
"sprout" -> return Sprout
"sapling" -> return Sapling
"orchard" -> return Orchard
_ -> fail "Not a known Zcash pool"
data ZcashAddress = ZcashAddress
{ source :: AddressSource
, pool :: [ZcashPool]

44
src/Zenith/Utils.hs
View file

@ -9,8 +9,6 @@ import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Char (isAlphaNum, isSpace)
import System.Directory
import System.Process (createProcess_, shell)
import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
@ -85,13 +83,6 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
chkS = isValidShieldedAddress $ E.encodeUtf8 txt
-- | Return True if Address is valid
validateAddressBool :: T.Text -> Bool
validateAddressBool a = do
case (validateAddress a) of
Nothing -> False
_ -> True
-- | Copy an address to the clipboard
copyAddress :: ZcashAddress -> IO ()
copyAddress a =
@ -99,12 +90,6 @@ copyAddress a =
createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
-- | Get current user and build zenith path
getZenithPath :: IO String
getZenithPath = do
homeDirectory <- getHomeDirectory
return (homeDirectory ++ "/Zenith/")
-- | Bound a value to the 0..1 range, used for progress reporting on UIs
validBarValue :: Float -> Float
validBarValue = clamp (0, 1)
@ -118,7 +103,7 @@ isRecipientValid a =
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False)
@ -135,30 +120,3 @@ parseAddress a znet =
Just a3 ->
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> Nothing
isValidContent :: String -> Bool
isValidContent [] = False -- an empty string is invalid
isValidContent (x:xs)
| not (isAlphaNum x ) = False -- string must start with an alphanumeric character
| otherwise = allValidChars xs -- process the rest of the string
where
allValidChars :: String -> Bool
allValidChars [] = True -- if we got here, string is valid
allValidChars (y:ys)
| isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
| otherwise = False -- found an invalid character, return false
isValidString :: T.Text -> Bool
isValidString c = do
let a = T.unpack c
isValidContent a
padWithZero :: Int -> String -> String
padWithZero n s
| (length s) >= n = s
| otherwise = padWithZero n ("0" ++ s)
isEmpty :: [a] -> Bool
isEmpty [] = True
isEmpty _ = False

650
test/ServerSpec.hs
View file

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

6
test/Spec.hs
View file

@ -195,7 +195,7 @@ main = do
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False))
it "Sapling" $ do
@ -209,7 +209,7 @@ main = do
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (En.encodeUtf8 a) of
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False))
it "Transparent" $ do
@ -222,7 +222,7 @@ main = do
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False))
it "Check Sapling Address" $ do

2
zcash-haskell

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

878
zenith-openrpc.json
View file

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

74
zenith.cabal
View file

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