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/

.gitmodules

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

CHANGELOG.md

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

app/Main.hs

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

app/Server.hs

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

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

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

src/Zenith/GUI.hs

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

src/Zenith/RPC.hs

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

src/Zenith/Scanner.hs

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

src/Zenith/Tree.hs

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

src/Zenith/Types.hs

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

src/Zenith/Utils.hs

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

src/Zenith/Zcashd.hs

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

test/ServerSpec.hs

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

zcash-haskell

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

zenith-openrpc.json

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

zenith.cabal

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