Milestone 3: RPC server, ZIP-320 (#104)

This PR contains the following changes:

- New RPC server for programmatic access to the wallet.
- Support for ZIP-320, TEX addresses and shielding/de-shielding of funds
- Native Haskell implementation of the Zcash commitment trees

Co-authored-by: Rene Vergara A. <rvergara59@protonmail.com>
Reviewed-on: https://git.vergara.tech///Vergara_Tech/zenith/pulls/104
Co-authored-by: pitmutt <rene@vergara.network>
Co-committed-by: pitmutt <rene@vergara.network>

.gitmodules

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

CHANGELOG.md

@@ -5,6 +5,37 @@ 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]
+
+### 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)
+
+### 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]
 
 ### Added

app/Main.hs

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

app/Server.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+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 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.Scanner (rescanZebra)
+import Zenith.Types (Config(..))
+import Zenith.Utils (getZenithPath)
+
+main :: IO ()
+main = do
+  config <- load ["$(HOME)/Zenith/zenith.cfg"]
+  dbFileName <- require config "dbFileName"
+  nodeUser <- require config "nodeUser"
+  nodePwd <- require config "nodePwd"
+  zebraPort <- require config "zebraPort"
+  zebraHost <- require config "zebraHost"
+  nodePort <- require config "nodePort"
+  dbFP <- getZenithPath
+  let dbFilePath = T.pack $ dbFP ++ dbFileName
+  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
+  let ctx = authenticate myConfig :. EmptyContext
+  w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
+  case w of
+    Right zebra -> do
+      bc <-
+        try $ checkBlockChain zebraHost zebraPort :: IO
+          (Either IOError ZebraGetBlockChainInfo)
+      case bc of
+        Left e1 -> throwIO e1
+        Right chainInfo -> do
+          x <- initDb dbFilePath
+          case x of
+            Left e2 -> throwIO $ userError e2
+            Right x' -> do
+              when x' $ rescanZebra zebraHost zebraPort dbFilePath
+              pool <- runNoLoggingT $ initPool dbFilePath
+              walList <- getWallets pool $ zgb_net chainInfo
+              if not (null walList)
+                then do
+                  scanThread <-
+                    forkIO $
+                    forever $ do
+                      _ <-
+                        scanZebra
+                          dbFilePath
+                          zebraHost
+                          zebraPort
+                          (zgb_net chainInfo)
+                      threadDelay 90000000
+                  putStrLn "Zenith RPC Server 0.7.0.0-beta"
+                  putStrLn "------------------------------"
+                  putStrLn $
+                    "Connected to " ++
+                    show (zgb_net chainInfo) ++
+                    " Zebra " ++
+                    T.unpack (zgi_build zebra) ++ " on port " ++ show zebraPort
+                  let myState =
+                        State
+                          (zgb_net chainInfo)
+                          zebraHost
+                          zebraPort
+                          dbFilePath
+                          (zgi_build zebra)
+                          (zgb_blocks chainInfo)
+                  run nodePort $
+                    serveWithContext
+                      (Proxy :: Proxy ZenithRPC)
+                      ctx
+                      (zenithServer myState)
+                else putStrLn
+                       "No wallets available. Please start Zenith interactively to create a wallet"

app/ZenScan.hs

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

cabal.project.freeze

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

src/Zenith/CLI.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Zenith.CLI where
 
@@ -10,16 +11,15 @@ import qualified Brick.BChan as BC
 import qualified Brick.Focus as F
 import Brick.Forms
   ( Form(..)
-  , FormFieldState
   , (@@=)
   , allFieldsValid
-  , editShowableField
   , editShowableFieldWithValidate
   , editTextField
   , focusedFormInputAttr
   , handleFormEvent
   , invalidFormInputAttr
   , newForm
+  , radioField
   , renderForm
   , setFieldValid
   , updateFormState
@@ -42,7 +42,6 @@ import Brick.Widgets.Core
   , joinBorders
   , padAll
   , padBottom
-  , padLeft
   , padTop
   , setAvailableSize
   , str
@@ -63,13 +62,20 @@ import qualified Brick.Widgets.Edit as E
 import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.ProgressBar as P
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (catch, throw, throwIO, try)
+import Control.Exception (throw, throwIO, try)
-import Control.Monad (forever, void)
+import Control.Monad (forM_, forever, unless, void, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
+import Control.Monad.Logger
+  ( LoggingT
+  , NoLoggingT
+  , logDebugN
+  , runNoLoggingT
+  , runStderrLoggingT
+  )
 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)
@@ -83,10 +89,13 @@ import Lens.Micro.Mtl
 import Lens.Micro.TH
 import System.Hclip
 import Text.Printf
-import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
+import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
-import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
+import ZcashHaskell.Keys (generateWalletSeedPhrase)
-import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
+import ZcashHaskell.Orchard
-import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
+  ( getSaplingFromUA
+  , isValidUnifiedAddress
+  , parseAddress
+  )
 import ZcashHaskell.Transparent
   ( decodeTransparentAddress
   , encodeTransparentReceiver
@@ -95,19 +104,26 @@ import ZcashHaskell.Types
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
-import Zenith.Scanner (processTx, updateConfs)
+import Zenith.Scanner (checkIntegrity, 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
   )
@@ -126,6 +142,14 @@ data Name
   | ABList
   | DescripField
   | AddressField
+  | PrivacyNoneField
+  | PrivacyLowField
+  | PrivacyMediumField
+  | PrivacyFullField
+  | ShieldField
+  | DeshieldField
+  | TotalTranspField
+  | TotalShieldedField
   deriving (Eq, Show, Ord)
 
 data DialogInput = DialogInput
@@ -136,8 +160,9 @@ makeLenses ''DialogInput
 
 data SendInput = SendInput
   { _sendTo :: !T.Text
-  , _sendAmt :: !Float
+  , _sendAmt :: !Scientific
   , _sendMemo :: !T.Text
+  , _policyField :: !PrivacyPolicy
   } deriving (Show)
 
 makeLenses ''SendInput
@@ -149,6 +174,12 @@ data AdrBookEntry = AdrBookEntry
 
 makeLenses ''AdrBookEntry
 
+newtype ShDshEntry = ShDshEntry
+  { _shAmt :: Scientific
+  } deriving (Show)
+
+makeLenses ''ShDshEntry
+
 data DialogType
   = WName
   | AName
@@ -161,6 +192,8 @@ data DialogType
   | AdrBookForm
   | AdrBookUpdForm
   | AdrBookDelForm
+  | DeshieldForm
+  | ShieldForm
 
 data DisplayType
   = AddrDisplay
@@ -178,6 +211,9 @@ data Tick
   | TickMsg !String
   | TickTx !HexString
 
+data DropDownItem =
+  DropdownItem String
+
 data State = State
   { _network :: !ZcashNet
   , _wallets :: !(L.List Name (Entity ZcashWallet))
@@ -206,6 +242,9 @@ 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
@@ -222,11 +261,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
@@ -253,17 +292,24 @@ 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))) <=>
-      C.hCenter
+      (vBox
+         [ C.hCenter
              (hBox
                 [ capCommand "W" "allets"
                 , capCommand "A" "ccounts"
                 , capCommand "V" "iew address"
-           , capCommand "S" "end Tx"
+                , capCommand3 "" "S" "end Tx"
-           , capCommand2 "Address " "B" "ook"
+                ])
+         , C.hCenter
+             (hBox
+                [ capCommand2 "Address " "B" "ook"
+                , capCommand2 "s" "H" "ield"
+                , capCommand "D" "e-shield"
                 , capCommand "Q" "uit"
                 , capCommand "?" " Help"
                 , str $ show (st ^. timer)
                 ])
+         ])
     listBox :: Show e => String -> L.List Name e -> Widget Name
     listBox titleLabel l =
       C.vCenter $
@@ -329,7 +375,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", "q"]
+          map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "q"]
         actionList =
           map
             (hLimit 40 . str)
@@ -340,6 +386,7 @@ 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
@@ -386,6 +433,37 @@ 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 ->
@@ -450,7 +528,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.6.0.0-beta")) <=>
+                  (withAttr titleAttr (str "Zcash Wallet v0.7.0.0-beta")) <=>
                 C.hCenter (withAttr blinkAttr $ str "Press any key..."))
         else emptyWidget
     capCommand3 :: String -> String -> String -> Widget Name
@@ -610,14 +688,34 @@ mkInputForm =
 mkSendForm :: Integer -> SendInput -> Form SendInput e Name
 mkSendForm bal =
   newForm
-    [ label "To:     " @@= editTextField sendTo RecField (Just 1)
+    [ 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 "Amount: " @@=
       editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
     , label "Memo:   " @@= editTextField sendMemo MemoField (Just 1)
     ]
   where
-    isAmountValid :: Integer -> Float -> Bool
+    isAmountValid :: Integer -> Scientific -> Bool
-    isAmountValid b i = (fromIntegral b / 100000000.0) >= i
+    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)
     label s w =
       padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
 
@@ -722,19 +820,32 @@ abSelAttr = A.attrName "abselected"
 abMBarAttr :: A.AttrName
 abMBarAttr = A.attrName "menubar"
 
-scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
+scanZebra ::
-scanZebra dbP zHost zPort b eChan = do
+     T.Text
-  _ <- liftIO $ initDb dbP
+  -> T.Text
+  -> Int
+  -> Int
+  -> BC.BChan Tick
+  -> ZcashNet
+  -> NoLoggingT IO ()
+scanZebra dbP zHost zPort b eChan znet = do
   bStatus <- liftIO $ checkBlockChain zHost zPort
-  pool <- runNoLoggingT $ initPool dbP
+  pool <- liftIO $ runNoLoggingT $ initPool dbP
-  dbBlock <- runNoLoggingT $ getMaxBlock pool
+  dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
-  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
+  chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
-  case confUp of
+  syncChk <- liftIO $ isSyncing pool
-    Left _e0 ->
+  if syncChk
-      liftIO $
+    then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
-      BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
+    else do
-    Right _ -> do
+      logDebugN $
-      let sb = max dbBlock b
+        "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
       if sb > zgb_blocks bStatus || sb < 1
         then do
           liftIO $
@@ -746,8 +857,28 @@ scanZebra dbP zHost zPort b eChan = do
               let step =
                     (1.0 :: Float) /
                     fromIntegral (zgb_blocks bStatus - (sb + 1))
-              mapM_ (processBlock pool step) bList
+              _ <- liftIO $ startSync pool
-            else liftIO $ BC.writeBChan eChan $ TickVal 1.0
+              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"
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -759,7 +890,9 @@ scanZebra dbP zHost zPort b eChan = do
           "getblock"
           [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
       case r of
-        Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
+        Left e1 -> do
+          _ <- liftIO $ completeSync pool Failed
+          liftIO $ BC.writeBChan eChan $ TickMsg e1
         Right blk -> do
           r2 <-
             liftIO $
@@ -769,19 +902,21 @@ scanZebra dbP zHost zPort b eChan = do
               "getblock"
               [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
           case r2 of
-            Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
+            Left e2 -> do
+              _ <- liftIO $ completeSync pool Failed
+              liftIO $ BC.writeBChan eChan $ TickMsg e2
             Right hb -> do
               let blockTime = getBlockTime hb
-              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
+              bi <-
-                bl_txs $ addTime blk blockTime
+                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
               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
@@ -791,7 +926,35 @@ appEvent (BT.AppEvent t) = do
     TickMsg m -> do
       case s ^. displayBox of
         AddrDisplay -> return ()
-        MsgDisplay -> 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
         PhraseDisplay -> return ()
         TxDisplay -> return ()
         TxIdDisplay -> return ()
@@ -814,26 +977,9 @@ appEvent (BT.AppEvent t) = do
         SyncDisplay -> do
           if s ^. barValue == 1.0
             then do
-              selWallet <-
+              BT.modify $ set msg "Decoding, please wait..."
-                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))
-                  selWallet
-              BT.modify $ set displayBox BlankDisplay
               BT.modify $ set barValue 0.0
-              updatedState <- BT.get
+              BT.modify $ set displayBox MsgDisplay
-              ns <- liftIO $ refreshWallet updatedState
-              BT.put ns
             else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
         BlankDisplay -> do
           case s ^. dialogBox of
@@ -847,21 +993,27 @@ 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
+                  sBlock <-
+                    liftIO $
+                    getMinBirthdayHeight pool (ZcashNetDB $ s ^. network)
                   _ <-
                     liftIO $
                     forkIO $
+                    runNoLoggingT $
                     scanZebra
                       (s ^. dbPath)
                       (s ^. zebraHost)
                       (s ^. zebraPort)
                       sBlock
                       (s ^. eventDispatch)
+                      (s ^. network)
                   BT.modify $ set timer 0
                   return ()
                 else BT.modify $ set timer $ 1 + s ^. timer
@@ -1063,7 +1215,8 @@ appEvent (BT.VtyEvent e) = do
                                     Just (_k, w) -> return w
                              fs1 <- BT.zoom txForm $ BT.gets formState
                              bl <-
-                               liftIO $ getLastSyncBlock pool $ entityKey selWal
+                               liftIO $
+                               getChainTip (s ^. zebraHost) (s ^. zebraPort)
                              _ <-
                                liftIO $
                                forkIO $
@@ -1078,6 +1231,7 @@ 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
@@ -1091,8 +1245,103 @@ appEvent (BT.VtyEvent e) = do
                            fs <- BT.gets formState
                            BT.modify $
                              setFieldValid
-                               (isRecipientValid (fs ^. sendTo))
+                               (isRecipientValidGUI
+                                  (fs ^. policyField)
+                                  (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') [] ->
@@ -1110,7 +1359,7 @@ appEvent (BT.VtyEvent e) = do
                                "Address copied to Clipboard from >>\n" ++
                                T.unpack (addressBookAbdescrip (entityVal a))
                              BT.modify $ set displayBox MsgDisplay
-                           _ -> do
+                           _any -> do
                              BT.modify $
                                set msg "Error while copying the address!!"
                              BT.modify $ set displayBox MsgDisplay
@@ -1125,7 +1374,8 @@ appEvent (BT.VtyEvent e) = do
                                  (SendInput
                                     (addressBookAbaddress (entityVal a))
                                     0.0
-                                    "")
+                                    ""
+                                    Full)
                              BT.modify $ set dialogBox SendTx
                            _ -> do
                              BT.modify $
@@ -1275,6 +1525,53 @@ 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
@@ -1297,10 +1594,61 @@ appEvent (BT.VtyEvent e) = do
                        V.EvKey (V.KChar 's') [] -> do
                          BT.modify $
                            set txForm $
-                           mkSendForm (s ^. balance) (SendInput "" 0.0 "")
+                           mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
                          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 ->
@@ -1315,6 +1663,8 @@ 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
@@ -1363,15 +1713,22 @@ runZenithTUI config = do
       case bc of
         Left e1 -> throwIO e1
         Right chainInfo -> do
-          initDb dbFilePath
+          x <- initDb dbFilePath
+          _ <- upgradeQrTable pool
+          case x of
+            Left e2 -> throwIO $ userError e2
+            Right x' -> do
+              when x' $ rescanZebra host port dbFilePath
               walList <- getWallets pool $ zgb_net chainInfo
               accList <-
                 if not (null walList)
-              then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
+                  then runNoLoggingT $
+                       getAccounts pool $ entityKey $ head walList
                   else return []
               addrList <-
                 if not (null accList)
-              then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
+                  then runNoLoggingT $
+                       getAddresses pool $ entityKey $ head accList
                   else return []
               txList <-
                 if not (null addrList)
@@ -1390,6 +1747,14 @@ 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 $
@@ -1403,11 +1768,12 @@ runZenithTUI config = do
                 State
                   (zgb_net chainInfo)
                   (L.list WList (Vec.fromList walList) 1)
-              (L.list AcList (Vec.fromList accList) 0)
+                  (L.list AcList (Vec.fromList accList) 1)
                   (L.list AList (Vec.fromList addrList) 1)
                   (L.list TList (Vec.fromList txList) 1)
                   ("Start up Ok! Connected to Zebra " ++
-               (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
+                   (T.unpack . zgi_build) zebra ++
+                   " on port " ++ show port ++ ".")
                   False
                   (if null walList
                      then WName
@@ -1425,13 +1791,16 @@ runZenithTUI config = do
                   1.0
                   eventChan
                   0
-              (mkSendForm 0 $ SendInput "" 0.0 "")
+                  (mkSendForm 0 $ SendInput "" 0.0 "" Full)
                   (L.list ABList (Vec.fromList abookList) 1)
                   (mkNewABForm (AdrBookEntry "" ""))
                   ""
                   Nothing
                   uBal
-    Left e -> do
+                  (mkDeshieldForm 0 (ShDshEntry 0.0))
+                  tBal
+                  sBal
+    Left _e -> do
       print $
         "No Zebra node available on port " <>
         show port <> ". Check your configuration."
@@ -1450,7 +1819,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 selWallet
+  let bl = zcashWalletLastSync $ entityVal $ walList !! ix
   addrL <-
     if not (null aL)
       then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@@ -1641,22 +2010,90 @@ sendTransaction ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> Scientific
   -> T.Text
   -> T.Text
+  -> PrivacyPolicy
   -> IO ()
-sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
+sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
   BC.writeBChan chan $ TickMsg "Preparing transaction..."
-  case parseAddress ua znet of
+  case parseAddress (E.encodeUtf8 ua) of
     Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
     Just outUA -> do
       res <-
-        runFileLoggingT "zenith.log" $
+        runNoLoggingT $
-        prepareTx pool zHost zPort znet accId bl amt outUA memo
+        prepareTxV2
-      BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
+          pool
+          zHost
+          zPort
+          znet
+          accId
+          bl
+          [ ProposedNote
+              (ValidAddressAPI outUA)
+              amt
+              (if memo == ""
+                 then Nothing
+                 else Just memo)
+          ]
+          policy
       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/Theme.hs

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

src/Zenith/RPC.hs

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

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

@@ -0,0 +1,400 @@
+{-# 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

@@ -10,23 +10,37 @@
 module Zenith.Types where
 
 import Data.Aeson
+import Data.Aeson.TH (deriveJSON)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C
 import Data.HexString
+import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
+import 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
-  ( OrchardSpendingKey(..)
+  ( ExchangeAddress(..)
+  , OrchardSpendingKey(..)
   , Phrase(..)
   , Rseed(..)
+  , SaplingAddress(..)
   , SaplingSpendingKey(..)
   , Scope(..)
+  , TransparentAddress(..)
   , TransparentSpendingKey
+  , ValidAddress(..)
   , ZcashNet(..)
   )
 
@@ -42,6 +56,9 @@ newtype ZcashNetDB = ZcashNetDB
   { getNet :: ZcashNet
   } deriving newtype (Eq, Show, Read)
 
+instance ToJSON ZcashNetDB where
+  toJSON (ZcashNetDB z) = toJSON z
+
 derivePersistField "ZcashNetDB"
 
 newtype UnifiedAddressDB = UnifiedAddressDB
@@ -92,8 +109,165 @@ data Config = Config
   { c_dbPath :: !T.Text
   , c_zebraHost :: !T.Text
   , c_zebraPort :: !Int
+  , c_zenithUser :: !BS.ByteString
+  , c_zenithPwd :: !BS.ByteString
+  , c_zenithPort :: !Int
   } deriving (Eq, Prelude.Show)
 
+data ZcashPool
+  = TransparentPool
+  | SproutPool
+  | SaplingPool
+  | OrchardPool
+  deriving (Show, Read, Eq)
+
+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"
+
+instance FromJSON ZcashPool where
+  parseJSON =
+    withText "ZcashPool" $ \case
+      "p2pkh" -> return TransparentPool
+      "sprout" -> return SproutPool
+      "sapling" -> return SaplingPool
+      "orchard" -> return OrchardPool
+      _ -> fail "Not a known Zcash pool"
+
+newtype ZenithUuid = ZenithUuid
+  { getUuid :: U.UUID
+  } deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
+
+derivePersistField "ZenithUuid"
+
+-- ** API types
+data ZcashWalletAPI = ZcashWalletAPI
+  { zw_index :: !Int
+  , zw_name :: !T.Text
+  , zw_network :: !ZcashNet
+  , zw_birthday :: !Int
+  , zw_lastSync :: !Int
+  } deriving (Eq, Prelude.Show)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashWalletAPI)
+
+data ZcashAccountAPI = ZcashAccountAPI
+  { za_index :: !Int
+  , za_wallet :: !Int
+  , za_name :: !T.Text
+  } deriving (Eq, Prelude.Show)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAccountAPI)
+
+data ZcashAddressAPI = ZcashAddressAPI
+  { zd_index :: !Int
+  , zd_account :: !Int
+  , zd_name :: !T.Text
+  , zd_ua :: !T.Text
+  , zd_legacy :: !(Maybe T.Text)
+  , zd_transparent :: !(Maybe T.Text)
+  } deriving (Eq, Prelude.Show)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAddressAPI)
+
+data ZcashNoteAPI = ZcashNoteAPI
+  { zn_txid :: !HexString
+  , zn_pool :: !ZcashPool
+  , zn_amount :: !Float
+  , zn_amountZats :: !Int64
+  , zn_memo :: !T.Text
+  , zn_confirmed :: !Bool
+  , zn_blockheight :: !Int
+  , zn_blocktime :: !Int
+  , zn_outindex :: !Int
+  , zn_change :: !Bool
+  } deriving (Eq, Prelude.Show)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashNoteAPI)
+
+data AccountBalance = AccountBalance
+  { acb_transparent :: !Int64
+  , acb_sapling :: !Int64
+  , acb_orchard :: !Int64
+  } deriving (Eq, Prelude.Show)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)
+
+data ZenithStatus
+  = Processing
+  | Failed
+  | Successful
+  deriving (Eq, Prelude.Show, Read)
+
+$(deriveJSON defaultOptions ''ZenithStatus)
+
+derivePersistField "ZenithStatus"
+
+data PrivacyPolicy
+  = None
+  | Low
+  | Medium
+  | Full
+  deriving (Eq, Show, Read, Ord)
+
+$(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
@@ -138,24 +312,6 @@ instance FromJSON AddressSource where
       "mnemonic_seed" -> return MnemonicSeed
       _ -> fail "Not a known address source"
 
-data ZcashPool
-  = Transparent
-  | Sprout
-  | Sapling
-  | Orchard
-  deriving (Show, Read, Eq, Generic, ToJSON)
-
-derivePersistField "ZcashPool"
-
-instance FromJSON ZcashPool where
-  parseJSON =
-    withText "ZcashPool" $ \case
-      "p2pkh" -> return Transparent
-      "sprout" -> return Sprout
-      "sapling" -> return Sapling
-      "orchard" -> return Orchard
-      _ -> fail "Not a known Zcash pool"
-
 data ZcashAddress = ZcashAddress
   { source :: AddressSource
   , pool :: [ZcashPool]
@@ -203,7 +359,8 @@ instance FromJSON AddressGroup where
           Nothing -> return []
           Just x -> do
             x' <- x .:? "addresses"
-            return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
+            return $
+              maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
       processSapling k s2 =
         case k of
           Nothing -> return []
@@ -211,7 +368,7 @@ instance FromJSON AddressGroup where
             where processOneSapling sx =
                     withObject "Sapling" $ \oS -> do
                       oS' <- oS .: "addresses"
-                      return $ map (ZcashAddress sx [Sapling] Nothing) oS'
+                      return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
       processUnified u =
         case u of
           Nothing -> return []

src/Zenith/Utils.hs

@@ -3,28 +3,38 @@
 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 System.Directory
 import System.Process (createProcess_, shell)
 import Text.Regex.Posix
-import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
+import ZcashHaskell.Orchard
+  ( encodeUnifiedAddress
+  , isValidUnifiedAddress
+  , parseAddress
+  )
 import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
 import ZcashHaskell.Transparent
   ( decodeExchangeAddress
   , decodeTransparentAddress
   )
 import ZcashHaskell.Types
-  ( SaplingAddress(..)
+  ( ExchangeAddress(..)
+  , SaplingAddress(..)
   , TransparentAddress(..)
   , UnifiedAddress(..)
+  , ValidAddress(..)
   , ZcashNet(..)
   )
+import ZcashHaskell.Utils (makeZebraCall)
 import Zenith.Types
   ( AddressGroup(..)
+  , PrivacyPolicy(..)
   , UnifiedAddressDB(..)
   , ZcashAddress(..)
   , ZcashPool(..)
@@ -69,9 +79,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 Transparent
+  | tReg = Just TransparentPool
-  | sReg && chkS = Just Sapling
+  | sReg && chkS = Just SaplingPool
-  | uReg && chk = Just Orchard
+  | uReg && chk = Just OrchardPool
   | otherwise = Nothing
   where
     transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@@ -83,6 +93,13 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
     chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
     chkS = isValidShieldedAddress $ E.encodeUtf8 txt
 
+-- | Return True if Address is valid
+validateAddressBool :: T.Text -> Bool
+validateAddressBool a = do
+  case (validateAddress a) of
+    Nothing -> False
+    _ -> True
+
 -- | Copy an address to the clipboard
 copyAddress :: ZcashAddress -> IO ()
 copyAddress a =
@@ -90,12 +107,18 @@ copyAddress a =
   createProcess_ "toClipboard" $
   shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
 
+-- | Get current user and build zenith path
+getZenithPath :: IO String
+getZenithPath = do
+  homeDirectory <- getHomeDirectory
+  return (homeDirectory ++ "/Zenith/")
+
 -- | Bound a value to the 0..1 range, used for progress reporting on UIs
 validBarValue :: Float -> Float
 validBarValue = clamp (0, 1)
 
 isRecipientValid :: T.Text -> Bool
-isRecipientValid a =
+isRecipientValid a = do
   case isValidUnifiedAddress (E.encodeUtf8 a) of
     Just _a1 -> True
     Nothing ->
@@ -103,12 +126,84 @@ isRecipientValid a =
       (case decodeTransparentAddress (E.encodeUtf8 a) of
          Just _a3 -> True
          Nothing ->
-           case decodeExchangeAddress a of
+           case decodeExchangeAddress (E.encodeUtf8 a) of
              Just _a4 -> True
              Nothing -> False)
 
-parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
+isUnifiedAddressValid :: T.Text -> Bool
-parseAddress a znet =
+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 =
   case isValidUnifiedAddress (E.encodeUtf8 a) of
     Just a1 -> Just a1
     Nothing ->
@@ -120,3 +215,36 @@ parseAddress a znet =
             Just a3 ->
               Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
             Nothing -> Nothing
+
+isValidContent :: String -> Bool
+isValidContent [] = False --  an empty string is invalid   
+isValidContent (x:xs)
+  | not (isAlphaNum x) = False --  string must start with an alphanumeric character
+  | otherwise = allValidChars xs --  process the rest of the string 
+  where
+    allValidChars :: String -> Bool
+    allValidChars [] = True -- if we got here, string is valid
+    allValidChars (y:ys)
+      | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
+      | otherwise = False -- found an invalid character, return false  
+
+isValidString :: T.Text -> Bool
+isValidString c = do
+  let a = T.unpack c
+  isValidContent a
+
+padWithZero :: Int -> String -> String
+padWithZero n s
+  | (length s) >= n = s
+  | otherwise = padWithZero n ("0" ++ s)
+
+isEmpty :: [a] -> Bool
+isEmpty [] = True
+isEmpty _ = False
+
+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,9 +123,10 @@ sendTx user pwd fromAddy toAddy amount memo = do
       if source fromAddy /= ImportedWatchOnly
         then do
           let privacyPolicy
-                | valAdd == Just Transparent = "AllowRevealedRecipients"
+                | valAdd == Just TransparentPool = "AllowRevealedRecipients"
                 | isNothing (account fromAddy) &&
-                    elem Transparent (pool fromAddy) = "AllowRevealedSenders"
+                    elem TransparentPool (pool fromAddy) =
+                  "AllowRevealedSenders"
                 | otherwise = "AllowRevealedAmounts"
           let pd =
                 case memo of
@@ -301,7 +302,7 @@ sendWithUri user pwd fromAddy uri repTo = do
       let addType = validateAddress $ T.pack parsedAddress
       case addType of
         Nothing -> putStrLn "   Invalid address"
-        Just Transparent -> do
+        Just TransparentPool -> do
           putStrLn $ "   Address is valid: " ++ parsedAddress
           case (readMaybe parsedAmount :: Maybe Double) of
             Nothing -> putStrLn "   Invalid amount."

test/ServerSpec.hs

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

zcash-haskell

@@ -1 +1 @@
-Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2
+Subproject commit d45bd7dcf3c3cf4e893900a1774d24b14bf56591

zenith-openrpc.json

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

zenith.cabal

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