zrpc-docker - Zenith RPC server

- Docker Image distribution bundle generation

.gitignore

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

CHANGELOG.md

@@ -5,6 +5,26 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 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

app/Main.hs

@@ -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,12 +204,15 @@ main :: IO ()
 main = do
   config <- load ["$(HOME)/Zenith/zenith.cfg"]
   args <- getArgs
-  dbFilePath <- require config "dbFilePath"
+  dbFileName <- require config "dbFileName"
-  {-nodeUser <- require config "nodeUser"-}
+  nodeUser <- require config "nodeUser"
-  {-nodePwd <- require config "nodePwd"-}
+  nodePwd <- require config "nodePwd"
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
-  let myConfig = Config dbFilePath zebraHost zebraPort
+  nodePort <- require config "nodePort"
+  dbFP <- getZenithPath
+  let dbFilePath = T.pack $ dbFP ++ dbFileName
+  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
   if not (null args)
     then do
       case head args
@@ -226,7 +229,7 @@ main = do
             of
         "gui" -> runZenithGUI myConfig
         "tui" -> runZenithTUI myConfig
-        "rescan" -> clearSync myConfig
+        "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
         _ -> printUsage
     else printUsage
 
@@ -236,4 +239,5 @@ 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)"

app/Server.hs

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

app/ZenScan.hs

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

cabal.project.freeze

@@ -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.14.0,
+             any.base-compat ==0.13.1,
-             any.base-compat-batteries ==0.14.0,
+             any.base-compat-batteries ==0.13.1,
              any.base-orphans ==0.9.2,
              any.base16 ==1.0,
              any.base16-bytestring ==1.0.2.0,
@@ -59,9 +59,12 @@ constraints: any.Cabal ==3.10.3.0,
              any.blaze-builder ==0.4.2.3,
              any.blaze-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,
@@ -90,6 +93,7 @@ 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,
@@ -113,6 +117,7 @@ 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,
@@ -129,6 +134,7 @@ 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,
@@ -169,7 +175,12 @@ 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,
@@ -196,6 +207,7 @@ 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,
@@ -210,9 +222,13 @@ 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,
@@ -225,6 +241,9 @@ constraints: any.Cabal ==3.10.3.0,
              persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4,
              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,
@@ -236,6 +255,7 @@ 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,
@@ -260,8 +280,15 @@ constraints: any.Cabal ==3.10.3.0,
              semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
              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,
@@ -296,6 +323,7 @@ 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,
@@ -326,9 +354,18 @@ 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,

docker_files/Dockerfile

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

docker_files/bin/startrpc

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

docker_files/cfg/runzenithrpc

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

docker_files/cfg/zenith.cfg

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

docker_files/dockerpkg

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

docker_files/scripts/bash_rc_adm

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

docker_files/scripts/bash_rc_usr

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

docker_files/scripts/welcome.sh

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

docker_files/setup_docker

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

src/Zenith/CLI.hs

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

src/Zenith/Core.hs

@@ -4,7 +4,7 @@
 module Zenith.Core where
 
 import Control.Exception (throwIO, try)
-import Control.Monad (forM, when)
+import Control.Monad (forM, unless, when)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger
   ( LoggingT
@@ -73,6 +73,7 @@ import Zenith.Types
   , HexStringDB(..)
   , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
+  , PrivacyPolicy(..)
   , RseedDB(..)
   , SaplingSpendingKeyDB(..)
   , ScopeDB(..)
@@ -223,6 +224,47 @@ 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 ::
@@ -237,7 +279,7 @@ findSaplingOutputs config b znet za = do
   let zebraPort = c_zebraPort config
   let zn = getNet znet
   pool <- runNoLoggingT $ initPool dbPath
-  tList <- getShieldedOutputs pool b
+  tList <- getShieldedOutputs pool b znet
   trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
   let sT = SaplingCommitmentTree $ ztiSapling trees
   decryptNotes sT zn pool tList
@@ -328,7 +370,7 @@ findOrchardActions config b znet za = do
   let zebraPort = c_zebraPort config
   let zn = getNet znet
   pool <- runNoLoggingT $ initPool dbPath
-  tList <- getOrchardActions pool b
+  tList <- getOrchardActions pool b znet
   trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
   let sT = OrchardCommitmentTree $ ztiOrchard trees
   decryptNotes sT zn pool tList
@@ -495,19 +537,6 @@ 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-}
@@ -542,8 +571,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
               sSpends
               oSpends
               dummy
-              (SaplingSpendParams spParams)
-              (SaplingOutputParams outParams)
               zn
               (bh + 3)
               False
@@ -569,8 +596,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
                   sSpends
                   oSpends
                   outgoing
-                  (SaplingSpendParams spParams)
-                  (SaplingOutputParams outParams)
                   zn
                   (bh + 3)
                   True
@@ -645,7 +670,237 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
                        flipTxId
                        (fromIntegral $ walletTrNotePosition $ entityVal n))
                     (RawTxOut
-                       (walletTrNoteValue $ entityVal n)
+                       (fromIntegral $ walletTrNoteValue $ entityVal n)
+                       (walletTrNoteScript $ entityVal n))
+    prepSSpends ::
+         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
+    prepSSpends sk notes = do
+      forM notes $ \n -> do
+        return $
+          SaplingTxSpend
+            (getBytes sk)
+            (DecodedNote
+               (fromIntegral $ walletSapNoteValue $ entityVal n)
+               (walletSapNoteRecipient $ entityVal n)
+               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
+               (getHex $ walletSapNoteNullifier $ entityVal n)
+               ""
+               (getRseed $ walletSapNoteRseed $ entityVal n))
+            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
+    prepOSpends ::
+         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
+    prepOSpends sk notes = do
+      forM notes $ \n -> do
+        return $
+          OrchardTxSpend
+            (getBytes sk)
+            (DecodedNote
+               (fromIntegral $ walletOrchNoteValue $ entityVal n)
+               (walletOrchNoteRecipient $ entityVal n)
+               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
+               (getHex $ walletOrchNoteNullifier $ entityVal n)
+               (walletOrchNoteRho $ entityVal n)
+               (getRseed $ walletOrchNoteRseed $ entityVal n))
+            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
+    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
+    sapAnchor notes =
+      if not (null notes)
+        then Just $
+             SaplingWitness $
+             getHex $ walletSapNoteWitness $ entityVal $ head notes
+        else Nothing
+    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
+    orchAnchor notes =
+      if not (null notes)
+        then Just $
+             OrchardWitness $
+             getHex $ walletOrchNoteWitness $ entityVal $ head notes
+        else Nothing
+
+-- | Prepare a transaction for sending
+prepareTxV2 ::
+     ConnectionPool
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> Float
+  -> ValidAddress
+  -> T.Text
+  -> PrivacyPolicy
+  -> LoggingT IO (Either TxError HexString)
+prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
+  accRead <- liftIO $ getAccountById pool za
+  let recipient =
+        case va of
+          Unified ua ->
+            case o_rec ua of
+              Nothing ->
+                case s_rec ua of
+                  Nothing ->
+                    case t_rec ua of
+                      Nothing -> (0, "")
+                      Just r3 ->
+                        case tr_type r3 of
+                          P2PKH -> (1, toBytes $ tr_bytes r3)
+                          P2SH -> (2, toBytes $ tr_bytes r3)
+                  Just r2 -> (3, getBytes r2)
+              Just r1 -> (4, getBytes r1)
+          Sapling sa -> (3, getBytes $ sa_receiver sa)
+          Transparent ta ->
+            case tr_type (ta_receiver ta) of
+              P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
+              P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
+          Exchange ea ->
+            case tr_type (ex_address ea) of
+              P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
+              P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
+  logDebugN $ T.pack $ show recipient
+  logDebugN $ T.pack $ "Target block: " ++ show bh
+  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  let sT = SaplingCommitmentTree $ ztiSapling trees
+  let oT = OrchardCommitmentTree $ ztiOrchard trees
+  case accRead of
+    Nothing -> do
+      logErrorN "Can't find Account"
+      return $ Left ZHError
+    Just acc -> do
+      logDebugN $ T.pack $ show acc
+      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+      logDebugN $ T.pack $ show zats
+      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
+      --let fee = calculateTxFee firstPass $ fst recipient
+      --logDebugN $ T.pack $ "calculated fee " ++ show fee
+      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
+      logDebugN "selected notes"
+      logDebugN $ T.pack $ show tList
+      logDebugN $ T.pack $ show sList
+      logDebugN $ T.pack $ show oList
+      let noteTotal = getTotalAmount (tList, sList, oList)
+      tSpends <-
+        liftIO $
+        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
+      --print tSpends
+      sSpends <-
+        liftIO $
+        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
+      --print sSpends
+      oSpends <-
+        liftIO $
+        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
+      --print oSpends
+      dummy <-
+        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
+      logDebugN "Calculating fee"
+      let feeResponse =
+            createTransaction
+              (Just sT)
+              (Just oT)
+              tSpends
+              sSpends
+              oSpends
+              dummy
+              zn
+              (bh + 3)
+              False
+      case feeResponse of
+        Left e1 -> return $ Left Fee
+        Right fee -> do
+          let feeAmt =
+                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+          (tList1, sList1, oList1) <-
+            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
+          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
+          logDebugN $ T.pack $ show tList
+          logDebugN $ T.pack $ show sList
+          logDebugN $ T.pack $ show oList
+          outgoing <-
+            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
+          logDebugN $ T.pack $ show outgoing
+          let tx =
+                createTransaction
+                  (Just sT)
+                  (Just oT)
+                  tSpends
+                  sSpends
+                  oSpends
+                  outgoing
+                  zn
+                  (bh + 3)
+                  True
+          logDebugN $ T.pack $ show tx
+          return tx
+  where
+    makeOutgoing ::
+         Entity ZcashAccount
+      -> (Int, BS.ByteString)
+      -> Integer
+      -> Integer
+      -> IO [OutgoingNote]
+    makeOutgoing acc (k, recvr) zats chg = do
+      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
+      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
+      let chgRcvr =
+            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+      return
+        [ OutgoingNote
+            4
+            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+            (getBytes chgRcvr)
+            (fromIntegral chg)
+            ""
+            True
+        , OutgoingNote
+            (fromIntegral k)
+            (case k of
+               4 ->
+                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
+               3 ->
+                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
+               _ -> "")
+            recvr
+            (fromIntegral zats)
+            (E.encodeUtf8 memo)
+            False
+        ]
+    getTotalAmount ::
+         ( [Entity WalletTrNote]
+         , [Entity WalletSapNote]
+         , [Entity WalletOrchNote])
+      -> Integer
+    getTotalAmount (t, s, o) =
+      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
+      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
+      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
+    prepTSpends ::
+         TransparentSpendingKey
+      -> [Entity WalletTrNote]
+      -> IO [TransparentTxSpend]
+    prepTSpends sk notes = do
+      forM notes $ \n -> do
+        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
+        case tAddRead of
+          Nothing -> throwIO $ userError "Couldn't read t-address"
+          Just tAdd -> do
+            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
+              genTransparentSecretKey
+                (walletAddressIndex $ entityVal tAdd)
+                (getScope $ walletAddressScope $ entityVal tAdd)
+                sk
+            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
+            case mReverseTxId of
+              Nothing -> throwIO $ userError "failed to get tx ID"
+              Just (ESQ.Value reverseTxId) -> do
+                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
+                return $
+                  TransparentTxSpend
+                    xp_key
+                    (RawOutPoint
+                       flipTxId
+                       (fromIntegral $ walletTrNotePosition $ entityVal n))
+                    (RawTxOut
+                       (fromIntegral $ walletTrNoteValue $ entityVal n)
                        (walletTrNoteScript $ entityVal n))
     prepSSpends ::
          SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
@@ -700,19 +955,20 @@ 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 <- runNoLoggingT $ getMaxBlock pool
+  chainTip <- getMaxBlock pool znet
   let lastBlock = zcashWalletLastSync $ entityVal w
   let startBlock =
         if lastBlock > 0
           then lastBlock
           else zcashWalletBirthdayHeight $ entityVal w
-  mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
+  mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
-  mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
+  mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
   mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
   sapNotes <-
     liftIO $
@@ -728,48 +984,3 @@ 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

src/Zenith/DB.hs

@@ -18,18 +18,20 @@
 
 module Zenith.DB where
 
-import Control.Exception (throwIO)
+import Control.Exception (SomeException(..), throwIO, try)
-import Control.Monad (forM_, when)
+import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.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
@@ -40,17 +42,24 @@ import Haskoin.Transaction.Common
   , TxOut(..)
   , txHashToHex
   )
-import qualified Lens.Micro as ML ((&), (.~), (^.))
+import System.Directory (doesFileExist, getHomeDirectory, removeFile)
-import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import System.FilePath ((</>))
+import ZcashHaskell.Orchard
+  ( compareAddress
+  , getSaplingFromUA
+  , isValidUnifiedAddress
+  )
+import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
   ( DecodedNote(..)
+  , ExchangeAddress(..)
   , OrchardAction(..)
   , OrchardBundle(..)
-  , OrchardSpendingKey(..)
+  , OrchardReceiver(..)
   , OrchardWitness(..)
+  , SaplingAddress(..)
   , SaplingBundle(..)
-  , SaplingCommitmentTree(..)
+  , SaplingReceiver(..)
-  , SaplingSpendingKey(..)
   , SaplingWitness(..)
   , Scope(..)
   , ShieldedOutput(..)
@@ -61,11 +70,11 @@ import ZcashHaskell.Types
   , TransparentBundle(..)
   , TransparentReceiver(..)
   , UnifiedAddress(..)
-  , ZcashNet
+  , ValidAddress(..)
-  , decodeHexText
+  , ZcashNet(..)
   )
 import Zenith.Types
-  ( Config(..)
+  ( AccountBalance(..)
   , HexStringDB(..)
   , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
@@ -74,8 +83,14 @@ import Zenith.Types
   , ScopeDB(..)
   , TransparentSpendingKeyDB
   , UnifiedAddressDB(..)
+  , ZcashAccountAPI(..)
+  , ZcashAddressAPI(..)
   , ZcashNetDB(..)
+  , ZcashNoteAPI(..)
   , ZcashPool(..)
+  , ZcashWalletAPI(..)
+  , ZenithStatus(..)
+  , ZenithUuid(..)
   )
 
 share
@@ -128,24 +143,24 @@ share
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
     accId ZcashAccountId OnDeleteCascade OnUpdateCascade
     address WalletAddressId OnDeleteCascade OnUpdateCascade
-    value Word64
+    value Int64
     spent Bool
     script BS.ByteString
     change Bool
-    position Word64
+    position Int
     UniqueTNote tx script
     deriving Show Eq
   WalletTrSpend
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
     note WalletTrNoteId OnDeleteCascade OnUpdateCascade
     accId ZcashAccountId OnDeleteCascade OnUpdateCascade
-    value Word64
+    value Int64
     UniqueTrSpend tx accId
     deriving Show Eq
   WalletSapNote
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
     accId ZcashAccountId OnDeleteCascade OnUpdateCascade
-    value Word64
+    value Int64
     recipient BS.ByteString
     memo T.Text
     spent Bool
@@ -161,18 +176,18 @@ share
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
     note WalletSapNoteId OnDeleteCascade OnUpdateCascade
     accId ZcashAccountId OnDeleteCascade OnUpdateCascade
-    value Word64
+    value Int64
     UniqueSapSepnd tx accId
     deriving Show Eq
   WalletOrchNote
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
     accId ZcashAccountId OnDeleteCascade OnUpdateCascade
-    value Word64
+    value Int64
     recipient BS.ByteString
     memo T.Text
     spent Bool
     nullifier HexStringDB
-    position Word64
+    position Int64
     witness HexStringDB
     change Bool
     witPos OrchActionId OnDeleteIgnore OnUpdateIgnore
@@ -184,7 +199,7 @@ share
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
     note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
     accId ZcashAccountId OnDeleteCascade OnUpdateCascade
-    value Word64
+    value Int64
     UniqueOrchSpend tx accId
     deriving Show Eq
   ZcashTransaction
@@ -192,11 +207,12 @@ share
     txId HexStringDB
     conf Int
     time Int
-    UniqueTx block txId
+    network ZcashNetDB
+    UniqueTx block txId network
     deriving Show Eq
   TransparentNote
     tx ZcashTransactionId
-    value Word64
+    value Int64
     script BS.ByteString
     position Int
     UniqueTNPos tx position
@@ -260,15 +276,173 @@ 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 ()
+  -> IO (Either String Bool)
 initDb dbName = do
-  PS.runSqlite dbName $ do runMigration migrateAll
+  j <-
+    try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
+      (Either SomeException [T.Text])
+  case j of
+    Left _e1 -> do
+      pool <- runNoLoggingT $ initPool dbName
+      wallets <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do select . from $ table @ZcashWallet
+      accounts <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do select . from $ table @ZcashAccount
+      abook <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do select . from $ table @AddressBook
+      hDir <- getHomeDirectory
+      let backupDb = hDir </> "Zenith/.backup.db"
+      checkDbFile <- doesFileExist backupDb
+      when checkDbFile $ removeFile backupDb
+      _ <- PS.runSqlite (T.pack backupDb) $ runMigrationQuiet migrateAll
+      backupPool <- runNoLoggingT $ initPool $ T.pack backupDb
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> wallets
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> accounts
+      _ <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> abook
+      clearWalletTransactions pool
+      clearWalletData pool
+      m <-
+        try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
+          (Either SomeException [T.Text])
+      case m of
+        Left _e2 -> return $ Left "Failed to migrate data tables"
+        Right _ -> return $ Right True
+    Right _ -> return $ Right False
 
 initPool :: T.Text -> NoLoggingT IO ConnectionPool
 initPool dbPath = do
@@ -293,6 +467,36 @@ 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
@@ -367,14 +571,17 @@ saveAccount pool a =
 -- | Returns the largest block in storage
 getMaxBlock ::
      Pool SqlBackend -- ^ The database pool
-  -> NoLoggingT IO Int
+  -> ZcashNetDB
-getMaxBlock pool = do
+  -> IO Int
+getMaxBlock pool net = 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
@@ -474,15 +681,16 @@ 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 wt =
+saveTransaction pool t n 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
+      ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
     when (isJust $ tx_transpBundle wt) $ do
       _ <-
         insertMany_ $
@@ -561,14 +769,16 @@ saveTransaction pool t wt =
 getZcashTransactions ::
      ConnectionPool -- ^ The database path
   -> Int -- ^ Block
+  -> ZcashNet -- ^ Network
   -> IO [Entity ZcashTransaction]
-getZcashTransactions pool b =
+getZcashTransactions pool b net =
   runNoLoggingT $
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     select $ do
       txs <- from $ table @ZcashTransaction
-      where_ $ txs ^. ZcashTransactionBlock >. val b
+      where_ (txs ^. ZcashTransactionBlock >. val b)
+      where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
       orderBy [asc $ txs ^. ZcashTransactionBlock]
       return txs
 
@@ -748,9 +958,10 @@ 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 t = do
+findTransparentNotes pool b net t = do
   let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
   case tReceiver of
     Just tR -> do
@@ -770,6 +981,7 @@ findTransparentNotes pool b 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_
@@ -823,8 +1035,9 @@ saveSapNote pool wsn =
 getShieldedOutputs ::
      ConnectionPool -- ^ database path
   -> Int -- ^ block
+  -> ZcashNetDB -- ^ network to use
   -> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
-getShieldedOutputs pool b =
+getShieldedOutputs pool b net =
   runNoLoggingT $
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
@@ -834,6 +1047,7 @@ getShieldedOutputs pool b =
         (\(txs :& sOutputs) ->
            txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
       where_ (txs ^. ZcashTransactionBlock >=. val b)
+      where_ (txs ^. ZcashTransactionNetwork ==. val net)
       orderBy
         [ asc $ txs ^. ZcashTransactionId
         , asc $ sOutputs ^. ShieldOutputPosition
@@ -844,8 +1058,9 @@ getShieldedOutputs pool b =
 getOrchardActions ::
      ConnectionPool -- ^ database path
   -> Int -- ^ block
+  -> ZcashNetDB -- ^ network to use
   -> IO [(Entity ZcashTransaction, Entity OrchAction)]
-getOrchardActions pool b =
+getOrchardActions pool b net =
   runNoLoggingT $
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
@@ -855,10 +1070,97 @@ getOrchardActions pool b =
         (\(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
@@ -876,35 +1178,11 @@ getWalletTransactions pool w = do
   trNotes <-
     case tReceiver of
       Nothing -> return []
-      Just tR -> do
+      Just tR -> liftIO $ getTrNotes pool tR
-        let s =
-              BS.concat
-                [ BS.pack [0x76, 0xA9, 0x14]
-                , (toBytes . tr_bytes) tR
-                , BS.pack [0x88, 0xAC]
-                ]
-        PS.retryOnBusy $
-          flip PS.runSqlPool pool $ do
-            select $ do
-              tnotes <- from $ table @WalletTrNote
-              where_ (tnotes ^. WalletTrNoteScript ==. val s)
-              pure tnotes
   trChgNotes <-
     case ctReceiver of
       Nothing -> return []
-      Just tR -> do
+      Just tR -> liftIO $ getTrNotes pool tR
-        let s1 =
-              BS.concat
-                [ BS.pack [0x76, 0xA9, 0x14]
-                , (toBytes . tr_bytes) tR
-                , BS.pack [0x88, 0xAC]
-                ]
-        PS.retryOnBusy $
-          flip PS.runSqlPool pool $ do
-            select $ do
-              tnotes <- from $ table @WalletTrNote
-              where_ (tnotes ^. WalletTrNoteScript ==. val s1)
-              pure tnotes
   trSpends <-
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
@@ -917,44 +1195,20 @@ getWalletTransactions pool w = do
   sapNotes <-
     case sReceiver of
       Nothing -> return []
-      Just sR -> do
+      Just sR -> liftIO $ getSapNotes pool sR
-        PS.retryOnBusy $
-          flip PS.runSqlPool pool $ do
-            select $ do
-              snotes <- from $ table @WalletSapNote
-              where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
-              pure snotes
   sapChgNotes <-
     case csReceiver of
       Nothing -> return []
-      Just sR -> do
+      Just sR -> liftIO $ getSapNotes pool sR
-        PS.retryOnBusy $
-          flip PS.runSqlPool pool $ do
-            select $ do
-              snotes <- from $ table @WalletSapNote
-              where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
-              pure snotes
   sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
   orchNotes <-
     case oReceiver of
       Nothing -> return []
-      Just oR -> do
+      Just oR -> liftIO $ getOrchNotes pool oR
-        PS.retryOnBusy $
-          flip PS.runSqlPool pool $ do
-            select $ do
-              onotes <- from $ table @WalletOrchNote
-              where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
-              pure onotes
   orchChgNotes <-
     case coReceiver of
       Nothing -> return []
-      Just oR -> do
+      Just oR -> liftIO $ getOrchNotes pool oR
-        PS.retryOnBusy $
-          flip PS.runSqlPool pool $ do
-            select $ do
-              onotes <- from $ table @WalletOrchNote
-              where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
-              pure onotes
   orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
   clearUserTx (entityKey w)
   mapM_ addTr trNotes
@@ -1087,6 +1341,19 @@ 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 $
@@ -1146,7 +1413,7 @@ findTransparentSpends pool za = do
                   (trSpends ^. TransparentSpendOutPointHash ==. val flipTxId)
                 where_
                   (trSpends ^. TransparentSpendOutPointIndex ==.
-                   val (walletTrNotePosition $ entityVal n))
+                   val (fromIntegral $ walletTrNotePosition $ entityVal n))
                 pure (tx, trSpends)
           if null s
             then return ()
@@ -1383,6 +1650,34 @@ 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
@@ -1425,6 +1720,32 @@ 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 $
@@ -1454,6 +1775,32 @@ 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]
@@ -1610,7 +1957,7 @@ selectUnspentNotes pool za amt = do
     else return (tList, [], [])
   where
     checkTransparent ::
-         Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote])
+         Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
     checkTransparent x [] = (x, [])
     checkTransparent x (n:ns) =
       if walletTrNoteValue (entityVal n) < x
@@ -1619,7 +1966,7 @@ selectUnspentNotes pool za amt = do
                snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
         else (0, [n])
     checkSapling ::
-         Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote])
+         Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
     checkSapling x [] = (x, [])
     checkSapling x (n:ns) =
       if walletSapNoteValue (entityVal n) < x
@@ -1627,7 +1974,7 @@ selectUnspentNotes pool za amt = do
              , n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
         else (0, [n])
     checkOrchard ::
-         Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote])
+         Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
     checkOrchard x [] = (x, [])
     checkOrchard x (n:ns) =
       if walletOrchNoteValue (entityVal n) < x
@@ -1724,3 +2071,37 @@ 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)

src/Zenith/GUI.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BlockArguments #-}
 
 module Zenith.GUI where
 
@@ -9,17 +10,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 (fromJust, fromMaybe, isJust, isNothing)
+import Data.Maybe (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)
+import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
 import Database.Persist
 import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
 import Lens.Micro.TH
@@ -27,7 +28,6 @@ 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,7 +36,6 @@ import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
   ( BlockResponse(..)
-  , Phrase(..)
   , Scope(..)
   , ToBytes(..)
   , UnifiedAddress(..)
@@ -48,15 +47,20 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
 import Zenith.GUI.Theme
-import Zenith.Scanner (processTx, updateConfs)
+import Zenith.Scanner (processTx, rescanZebra, updateConfs)
 import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
+  , getZenithPath
+  , isEmpty
   , isRecipientValid
+  , isValidString
   , jsonNumber
+  , padWithZero
   , parseAddress
   , showAddress
   , validBarValue
+  , validateAddressBool
   )
 
 data AppEvent
@@ -102,6 +106,25 @@ 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
@@ -144,6 +167,16 @@ 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
@@ -185,6 +218,15 @@ 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
@@ -247,6 +289,8 @@ 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 =
@@ -750,6 +794,146 @@ 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
@@ -1030,6 +1214,7 @@ 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 ->
@@ -1040,12 +1225,11 @@ handleEvent wenv node model evt =
                    Nothing -> return $ ShowError "No wallet available"
                    Just cW -> do
                      syncWallet (model ^. configuration) cW
-                     return $ SwitchAddr (model ^. selAddr)
+                     pool <-
-             , Task $ do
+                       runNoLoggingT $
-                 pool <-
+                       initPool $ c_dbPath $ model ^. configuration
-                   runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
+                     wL <- getWallets pool (model ^. network)
-                 wL <- getWallets pool (model ^. network)
+                     return $ LoadWallets wL
-                 return $ LoadWallets wL
              ]
         else [ Model $
                model & barValue .~ validBarValue (i + model ^. barValue) &
@@ -1060,6 +1244,85 @@ 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)
@@ -1147,14 +1410,39 @@ 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 -> (AppEvent -> IO ()) -> IO ()
+scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
-scanZebra dbPath zHost zPort sendMsg = do
+scanZebra dbPath zHost zPort net sendMsg = do
-  _ <- liftIO $ initDb dbPath
   bStatus <- liftIO $ checkBlockChain zHost zPort
   pool <- runNoLoggingT $ initPool dbPath
   b <- liftIO $ getMinBirthdayHeight pool
-  dbBlock <- runNoLoggingT $ getMaxBlock pool
+  dbBlock <- getMaxBlock pool $ ZcashNetDB net
   let sb = max dbBlock b
   confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
   case confUp of
@@ -1193,7 +1481,7 @@ scanZebra dbPath zHost zPort sendMsg = do
             Left e2 -> sendMsg (ShowError $ showt e2)
             Right hb -> do
               let blockTime = getBlockTime hb
-              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
+              mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
                 bl_txs $ addTime blk blockTime
               sendMsg (SyncVal step)
     addTime :: BlockResponse -> Int -> BlockResponse
@@ -1246,6 +1534,9 @@ 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
 
@@ -1268,128 +1559,98 @@ runZenithGUI config = do
           case bc of
             Left e1 -> throwIO e1
             Right chainInfo -> do
-              initDb dbFilePath
+              x <- initDb dbFilePath
-              generateQRCodes config
+              case x of
-              walList <- getWallets pool $ zgb_net chainInfo
+                Left e2 -> throwIO $ userError e2
-              accList <-
+                Right x' -> do
-                if not (null walList)
+                  when x' $ rescanZebra host port dbFilePath
-                  then runNoLoggingT $
+                  generateQRCodes config
-                       getAccounts pool $ entityKey $ head walList
+                  walList <- getWallets pool $ zgb_net chainInfo
-                  else return []
+                  accList <-
-              addrList <-
+                    if not (null walList)
-                if not (null accList)
+                      then runNoLoggingT $
-                  then runNoLoggingT $
+                           getAccounts pool $ entityKey $ head walList
-                       getAddresses pool $ entityKey $ head accList
+                      else return []
-                  else return []
+                  addrList <-
-              txList <-
+                    if not (null accList)
-                if not (null addrList)
+                      then runNoLoggingT $
-                  then getUserTx pool $ entityKey $ head addrList
+                           getAddresses pool $ entityKey $ head accList
-                  else return []
+                      else return []
-              qr <-
+                  txList <-
-                if not (null addrList)
+                    if not (null addrList)
-                  then getQrCode pool Orchard $ entityKey $ head addrList
+                      then getUserTx pool $ entityKey $ head addrList
-                  else return Nothing
+                      else return []
-              bal <-
+                  qr <-
-                if not (null accList)
+                    if not (null addrList)
-                  then getBalance pool $ entityKey $ head accList
+                      then getQrCode pool Orchard $ entityKey $ head addrList
-                  else return 0
+                      else return Nothing
-              unconfBal <-
+                  bal <-
-                if not (null accList)
+                    if not (null accList)
-                  then getUnconfirmedBalance pool $ entityKey $ head accList
+                      then getBalance pool $ entityKey $ head accList
-                  else return 0
+                      else return 0
-              let model =
+                  unconfBal <-
-                    AppModel
+                    if not (null accList)
-                      config
+                      then getUnconfirmedBalance pool $ entityKey $ head accList
-                      (zgb_net chainInfo)
+                      else return 0
-                      walList
+                  abList <- getAdrBook pool (zgb_net chainInfo)
-                      0
+                  let model =
-                      accList
+                        AppModel
-                      0
+                          config
-                      addrList
+                          (zgb_net chainInfo)
-                      0
+                          walList
-                      txList
+                          0
-                      0
+                          accList
-                      Nothing
+                          0
-                      True
+                          addrList
-                      bal
+                          0
-                      (if unconfBal == 0
+                          txList
-                         then Nothing
+                          0
-                         else Just unconfBal)
+                          Nothing
-                      Orchard
+                          True
-                      qr
+                          bal
-                      False
+                          (if unconfBal == 0
-                      False
+                             then Nothing
-                      False
+                             else Just unconfBal)
-                      False
+                          Orchard
-                      ""
+                          qr
-                      Nothing
+                          False
-                      ""
+                          False
-                      ""
+                          False
-                      (SaveAddress $
+                          False
-                       if not (null accList)
+                          ""
-                         then Just (head accList)
+                          Nothing
-                         else Nothing)
+                          ""
-                      False
+                          ""
-                      False
+                          (SaveAddress $
-                      Nothing
+                           if not (null accList)
-                      Nothing
+                             then Just (head accList)
-                      0
+                             else Nothing)
-                      1.0
+                          False
-                      False
+                          False
-                      ""
+                          Nothing
-                      0.0
+                          Nothing
-                      ""
+                          0
-                      False
+                          1.0
-                      False
+                          False
-                      Nothing
+                          ""
-                      hD
+                          0.0
-              startApp model handleEvent buildUI (params hD)
+                          ""
-        Left e -> do
+                          False
-          initDb dbFilePath
+                          False
-          let model =
+                          Nothing
-                AppModel
+                          hD
-                  config
+                          False
-                  TestNet
+                          False
-                  []
+                          ""
-                  0
+                          ""
-                  []
+                          False
-                  0
+                          False
-                  []
+                          abList
-                  0
+                          Nothing
-                  []
+                          False
-                  0
+                          False
-                  (Just $
+                  startApp model handleEvent buildUI (params hD)
-                   "Couldn't connect to Zebra on " <>
+        Left _e -> print "Zebra not available"
-                   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"

src/Zenith/GUI/Theme.hs

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

src/Zenith/RPC.hs

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

src/Zenith/Scanner.hs

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

src/Zenith/Types.hs

@@ -10,14 +10,17 @@
 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
@@ -42,6 +45,9 @@ newtype ZcashNetDB = ZcashNetDB
   { getNet :: ZcashNet
   } deriving newtype (Eq, Show, Read)
 
+instance ToJSON ZcashNetDB where
+  toJSON (ZcashNetDB z) = toJSON z
+
 derivePersistField "ZcashNetDB"
 
 newtype UnifiedAddressDB = UnifiedAddressDB
@@ -92,8 +98,114 @@ 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
@@ -138,24 +250,6 @@ 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]

src/Zenith/Utils.hs

@@ -9,6 +9,8 @@ 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)
@@ -83,6 +85,13 @@ 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 =
@@ -90,6 +99,12 @@ 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)
@@ -103,7 +118,7 @@ isRecipientValid a =
       (case decodeTransparentAddress (E.encodeUtf8 a) of
          Just _a3 -> True
          Nothing ->
-           case decodeExchangeAddress a of
+           case decodeExchangeAddress (E.encodeUtf8 a) of
              Just _a4 -> True
              Nothing -> False)
 
@@ -120,3 +135,30 @@ 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
+  

test/ServerSpec.hs

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

test/Spec.hs

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

zcash-haskell

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

zenith-openrpc.json

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

zenith.cabal

@@ -1,6 +1,6 @@
 cabal-version:    3.0
 name:             zenith
-version:          0.6.0.0-beta
+version:          0.7.0.0-beta
 license:          MIT
 license-file:     LICENSE
 author:           Rene Vergara
@@ -35,56 +35,62 @@ 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
-    , filepath
     , esqueleto
-    , resource-pool
-    , binary
     , exceptions
-    , monad-logger
+    , filepath
-    , 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
@@ -110,15 +116,18 @@ executable zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
-executable zenscan
+executable zenithserver
-  ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
-  main-is: ZenScan.hs
+  main-is: Server.hs
   hs-source-dirs:
     app
   build-depends:
       base >=4.12 && <5
     , configurator
-    , monad-logger
+    , wai-extra
+    , warp
+    , servant-server
+    , zcash-haskell
     , zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
@@ -148,3 +157,34 @@ 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