Merge branch 'rvv001' of git.vergara.tech:Vergara_Tech/zenith into rvv001

.gitignore

@@ -5,3 +5,7 @@ zenith.db
 zenith.log
 zenith.db-shm
 zenith.db-wal
+test.db
+test.db-shm
+test.db-wal
+

.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,7 +5,7 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [Unreleased]
+## [0.7.0.0-beta]
 
 ### Added
 
@@ -20,13 +20,20 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 	- `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]

app/Main.hs

@@ -210,9 +210,18 @@ main = do
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
   nodePort <- require config "nodePort"
+  currencyCode <- require config "currencyCode"
   dbFP <- getZenithPath
   let dbFilePath = T.pack $ dbFP ++ dbFileName
-  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
+  let myConfig =
+        Config
+          dbFilePath
+          zebraHost
+          zebraPort
+          nodeUser
+          nodePwd
+          nodePort
+          currencyCode
   if not (null args)
     then do
       case head args

app/Server.hs

@@ -2,28 +2,51 @@
 
 module Server where
 
-import Control.Exception (throwIO, try)
+import Control.Concurrent (forkIO, threadDelay)
-import Control.Monad (when)
+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 (initDb)
+import Zenith.DB (getWallets, initDb, initPool)
-import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
+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"]
-  dbFilePath <- require config "dbFilePath"
+  dbFileName <- require config "dbFileName"
   nodeUser <- require config "nodeUser"
   nodePwd <- require config "nodePwd"
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
   nodePort <- require config "nodePort"
-  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
+  currencyCode <- require config "currencyCode"
+  dbFP <- getZenithPath
+  let dbFilePath = T.pack $ dbFP ++ dbFileName
+  let myConfig =
+        Config
+          dbFilePath
+          zebraHost
+          zebraPort
+          nodeUser
+          nodePwd
+          nodePort
+          currencyCode
   let ctx = authenticate myConfig :. EmptyContext
   w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
   case w of
@@ -39,6 +62,27 @@ main = do
             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)
@@ -52,3 +96,5 @@ main = do
                       (Proxy :: Proxy ZenithRPC)
                       ctx
                       (zenithServer myState)
+                else putStrLn
+                       "No wallets available. Please start Zenith interactively to create a wallet"

src/Zenith/GUI.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Zenith.GUI where
 
@@ -10,13 +11,20 @@ import Codec.QRCode
 import Codec.QRCode.JuicyPixels
 import Control.Concurrent (threadDelay)
 import Control.Exception (throwIO, try)
-import Control.Monad (unless, when)
+import Control.Monad (forM_, unless, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Control.Monad.Logger
+  ( LoggingT
+  , NoLoggingT
+  , logDebugN
+  , runNoLoggingT
+  , runStderrLoggingT
+  )
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.HexString (toText)
 import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.Scientific (Scientific, fromFloatDigits)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@@ -25,10 +33,11 @@ import Database.Persist
 import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
 import Lens.Micro.TH
 import Monomer
+
 import qualified Monomer.Lens as L
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
-import Text.Printf
+import Text.Printf (printf)
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import TextShow hiding (toText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
@@ -37,12 +46,16 @@ import ZcashHaskell.Orchard
   , isValidUnifiedAddress
   , parseAddress
   )
-import ZcashHaskell.Transparent (encodeTransparentReceiver)
+import ZcashHaskell.Transparent
+  ( decodeTransparentAddress
+  , encodeTransparentReceiver
+  )
 import ZcashHaskell.Types
   ( BlockResponse(..)
   , Scope(..)
   , ToBytes(..)
   , UnifiedAddress(..)
+  , ValidAddress(..)
   , ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
   , ZebraGetInfo(..)
@@ -55,15 +68,24 @@ import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
 import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
+  , getChainTip
+  , getZcashPrice
   , isRecipientValidGUI
   , isValidString
   , isZecAddressValid
   , jsonNumber
   , padWithZero
+  , parseZcashPayment
   , showAddress
   , validBarValue
   )
 
+data VkTypeDef
+  = VkNone
+  | VkFull
+  | VkIncoming
+  deriving (Eq, Show)
+
 data AppEvent
   = AppInit
   | ShowMsg !T.Text
@@ -74,6 +96,7 @@ data AppEvent
   | AccountClicked
   | MenuClicked
   | NewClicked
+  | ViewingKeysClicked
   | NewAddress !(Maybe (Entity ZcashAccount))
   | NewAccount !(Maybe (Entity ZcashWallet))
   | NewWallet
@@ -82,7 +105,7 @@ data AppEvent
   | SwitchAddr !Int
   | SwitchAcc !Int
   | SwitchWal !Int
-  | UpdateBalance !(Integer, Integer)
+  | UpdateBalance !(Integer, Integer, Integer, Integer)
   | CopyAddr !(Maybe (Entity WalletAddress))
   | LoadTxs ![Entity UserTx]
   | LoadAddrs ![Entity WalletAddress]
@@ -130,6 +153,21 @@ data AppEvent
   | CloseShield
   | ShowDeShield
   | CloseDeShield
+  | SendDeShield
+  | SendShield
+  | StartSync
+  | TreeSync
+  | ShowFIATBalance
+  | DisplayFIATBalance Double Double
+  | CloseFIATBalance
+  | ShowViewingKey !VkTypeDef !T.Text
+  | CopyViewingKey !T.Text !T.Text
+  | CloseShowVK
+  | DisplayPaymentURI
+  | ClosePaymentURI
+  | DisplayPayUsingURI
+  | ClosePayUsingURI
+  | ProcIfValidURI
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -189,6 +227,16 @@ data AppModel = AppModel
   , _tBalanceValid :: !Bool
   , _sBalance :: !Integer
   , _sBalanceValid :: !Bool
+  , _displayFIATBalance :: !Bool
+  , _zPrice :: !Double
+  , _aBal :: !Double
+  , _viewingKeyPopup :: !Bool
+  , _viewingKeyDisplay :: !Bool
+  , _vkTypeName :: !T.Text
+  , _vkData :: !T.Text
+  , _paymentURIDisplay :: !Bool
+  , _usepmtURIOverlay :: !Bool
+  , _uriString :: !T.Text
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -232,12 +280,16 @@ buildUI wenv model = widgetTree
         , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
         , adrbookOverlay `nodeVisible` model ^. showAdrBook
         , newAdrBkOverlay `nodeVisible` model ^. newAdrBkEntry
+        , dfBalOverlay `nodeVisible` model ^. displayFIATBalance
         , showABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
           model ^.
           showABAddress
         , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
           model ^.
           updateABAddress
+        , showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
+        , paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
+        , pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
         , shieldOverlay `nodeVisible` model ^. shieldZec
         , deShieldOverlay `nodeVisible` model ^. deShieldZec
         , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
@@ -309,6 +361,35 @@ buildUI wenv model = widgetTree
              [bgColor white, borderB 1 gray, padding 3]
            , box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [alignLeft]
+               (vstack
+                  [ box_
+                      [alignLeft, onClick ViewingKeysClicked]
+                      (hstack
+                         [ label "Viewing Keys"
+                         , filler
+                         , widgetIf (not $ model ^. viewingKeyPopup) $
+                           remixIcon remixMenuUnfoldFill
+                         , widgetIf (model ^. viewingKeyPopup) $
+                           remixIcon remixMenuFoldFill
+                         ])
+                  , widgetIf (model ^. viewingKeyPopup) $
+                    animSlideIn viewingKeysBox
+                  ]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [alignLeft, onClick ShowFIATBalance]
+               (label
+                  ("Balance in " <>
+                   T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_ [alignLeft, onClick DisplayPaymentURI] (label "Create URI") `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [alignLeft, onClick DisplayPayUsingURI]
+               (label "Pay using URI") `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
            ]) `styleBasic`
       [bgColor btnColor, padding 3]
     newBox =
@@ -328,6 +409,29 @@ buildUI wenv model = widgetTree
                (hstack [label "Wallet", filler]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            ])
+    viewingKeysBox =
+      box_
+        [alignMiddle]
+        (vstack
+           [ box_
+               [ alignLeft
+               , onClick
+                   (ShowViewingKey
+                      VkFull
+                      "VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")
+               ]
+               (hstack [label "Full VK", filler]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [ alignLeft
+               , onClick $
+                 (ShowViewingKey
+                    VkIncoming
+                    "VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")
+               ]
+               (hstack [label "Incoming VK", filler]) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           ])
     walletButton =
       hstack
         [ label "Wallet: " `styleBasic` [textFont "Bold", textColor white]
@@ -740,7 +844,7 @@ buildUI wenv model = widgetTree
       box
         (label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
          [textSize 12, textFont "Bold"]) `styleBasic`
-      [bgColor (white & L.a .~ 0.5)]
+      [bgColor (white & L.a .~ 0.7)]
     txOverlay =
       case model ^. showTx of
         Nothing -> alert CloseTx $ label "N/A"
@@ -974,6 +1078,49 @@ buildUI wenv model = widgetTree
         , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
         , filler
         ]
+    dfBalOverlay =
+      alert CloseFIATBalance $
+      vstack
+        [ box_
+            []
+            (label
+               ("Account Balance in " <>
+                (T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
+             [textFont "Bold", textSize 12, textColor white]) `styleBasic`
+          [bgColor btnColor, radius 2, padding 3]
+        , filler
+        , (label
+             ("1 ZEC = " <>
+              (T.pack (printf "%.2f" (model ^. zPrice))) <>
+              " " <> (T.toUpper (c_currencyCode (model ^. configuration))))) `styleBasic`
+          []
+        , filler
+        , (label
+             ((T.pack (printf "%.8f" (model ^. aBal)) <>
+               " ZEC = " <>
+               (T.pack (printf "%.2f" ((model ^. zPrice) * (model ^. aBal)))) <>
+               " " <> (T.toUpper (c_currencyCode (model ^. configuration)))))) `styleBasic`
+          []
+        ]
+    showVKOverlay =
+      alert CloseShowVK $
+      vstack
+        [ box_
+            []
+            (label ((model ^. vkTypeName) <> " Viewing Key") `styleBasic`
+             [textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic`
+          [bgColor btnColor, radius 2, padding 3]
+        , spacer
+        , hstack
+            [filler, label_ (txtWrapN (model ^. vkData) 64) [multiline], filler]
+        , spacer
+        , hstack
+            [ filler
+            , button "Copy to Clipboard" $
+              CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
+            , filler
+            ]
+        ]
     shieldOverlay =
       box
         (vstack
@@ -989,39 +1136,21 @@ buildUI wenv model = widgetTree
                            [textFont "Bold", textSize 12])
                       , separatorLine `styleBasic` [fgColor btnColor]
                       , spacer
-                      , hstack
+                      , label
-                          [ filler
+                          ("Shield " <>
-                          , label ("Amount : " ) `styleBasic`
+                           displayAmount (model ^. network) (model ^. tBalance) <>
-                            [width 50, textFont "Bold"]
+                           "?") `styleBasic`
-                          , spacer
+                        [width 50, textFont "Regular"]
-                          , label (displayAmount (model ^. network) 100 ) `styleBasic`
-                            [width 50, textFont "Bold"]
-                          , filler
---                          , spacer
---                          , numericField_
---                              sendAmount
---                              [ decimals 8
---                              , minValue 0.0
---                              , maxValue
---                                  (fromIntegral (model ^. tBalance) / 100000000.0)
---                              , validInput tBalanceValid
---                              , onChange CheckAmount
---                              ] `styleBasic`
---                            [ width 150
---                            , styleIf
---                                (not $ model ^. tBalanceValid)
---                                (textColor red)
---                            ]
-                          ]
                       , spacer
                       , box_
                           [alignMiddle]
                           (hstack
                              [ filler
-                              , mainButton "Proceed" NotImplemented `nodeEnabled` True
+                             , mainButton "Proceed" SendShield `nodeEnabled`
---                               (model ^. amountValid && model ^. recipientValid)
+                               True
                              , spacer
-                              , mainButton "Cancel" CloseShield `nodeEnabled` True
+                             , mainButton "Cancel" CloseShield `nodeEnabled`
+                               True
                              , filler
                              ])
                       ]) `styleBasic`
@@ -1046,14 +1175,25 @@ buildUI wenv model = widgetTree
                            [textFont "Bold", textSize 12])
                       , separatorLine `styleBasic` [fgColor btnColor]
                       , spacer
-                      , hstack 
+                      , box_
-                          [ (label "Total Transparent : " `styleBasic` [ textFont "Bold" ]) 
+                          []
-                          , (label "0.00" )
+                          (vstack
+                             [ hstack
+                                 [ label "Total Transparent : " `styleBasic`
+                                   [textFont "Bold"]
+                                 , label
+                                     (displayAmount
+                                        (model ^. network)
+                                        (model ^. tBalance))
                                  ]
                              , spacer
                              , hstack
-                          [ (label "Total Shielded : " `styleBasic` [ textFont "Bold" ]) 
+                                 [ label "Total Shielded : " `styleBasic`
-                          , (label "0.00" )
+                                   [textFont "Bold"]
+                                 , label
+                                     (displayAmount
+                                        (model ^. network)
+                                        (model ^. sBalance))
                                  ]
                              , spacer
                              , hstack
@@ -1065,7 +1205,8 @@ buildUI wenv model = widgetTree
                                      [ decimals 8
                                      , minValue 0.0
                                      , maxValue
-                                  (fromIntegral (model ^. sBalance) / 100000000.0)
+                                         (fromIntegral (model ^. sBalance) /
+                                          100000000.0)
                                      , validInput sBalanceValid
                                      , onChange CheckAmount
                                      ] `styleBasic`
@@ -1075,15 +1216,17 @@ buildUI wenv model = widgetTree
                                        (textColor red)
                                    ]
                                  ]
+                             ])
                       , spacer
                       , box_
                           [alignMiddle]
                           (hstack
                              [ filler
-                             , mainButton "Proceed" NotImplemented `nodeEnabled` True
+                             , mainButton "Proceed" SendDeShield `nodeEnabled`
---                               (model ^. amountValid && model ^. recipientValid)
+                               True
                              , spacer
-                             , mainButton "Cancel" CloseDeShield `nodeEnabled` True
+                             , mainButton "Cancel" CloseDeShield `nodeEnabled`
+                               True
                              , filler
                              ])
                       ]) `styleBasic`
@@ -1093,7 +1236,106 @@ buildUI wenv model = widgetTree
            , filler
            ]) `styleBasic`
       [bgColor (white & L.a .~ 0.5)]
-notImplemented = NotImplemented
+    paymentURIOverlay =
+      box
+        (vstack
+           [ filler
+           , hstack
+               [ filler
+               , box_
+                   []
+                   (vstack
+                      [ box_
+                          [alignMiddle]
+                          (label "Create URI" `styleBasic`
+                           [textColor white, textFont "Bold", textSize 12]) `styleBasic`
+                        [bgColor btnColor]
+                      , separatorLine `styleBasic` [fgColor btnColor]
+                      , spacer
+                      , hstack
+                          [ label "Amount:" `styleBasic`
+                            [width 50, textFont "Bold"]
+                          , spacer
+                          , numericField_
+                              sendAmount
+                              [ decimals 8
+                              , minValue 0.0
+                              , maxValue
+                                  (fromIntegral (model ^. balance) / 100000000.0)
+                              , validInput amountValid
+                              , onChange CheckAmount
+                              ] `styleBasic`
+                            [ width 150
+                            , styleIf
+                                (not $ model ^. amountValid)
+                                (textColor red)
+                            ]
+                          ]
+                      , hstack
+                          [ label "Memo:" `styleBasic`
+                            [width 50, textFont "Bold"]
+                          , spacer
+                          , textArea sendMemo `styleBasic`
+                            [width 150, height 40]
+                          ]
+                      , spacer
+                      , box_
+                          [alignMiddle]
+                          (hstack
+                             [ spacer
+                             , mainButton "Create URI" NotImplemented `nodeEnabled`
+                               True
+                             , spacer
+                             , button "Cancel" ClosePaymentURI
+                             , spacer
+                             ])
+                      ]) `styleBasic`
+                 [radius 4, border 2 btnColor, bgColor white, padding 4]
+               , filler
+               ]
+           , filler
+           ]) `styleBasic`
+      [bgColor (white & L.a .~ 0.5)]
+    pmtUsingURIOverlay =
+      box
+        (vstack
+           [ filler
+           , hstack
+               [ filler
+               , box_
+                   []
+                   (vstack
+                      [ box_
+                          [alignMiddle]
+                          (label "Pay using URI" `styleBasic`
+                           [textColor white, textFont "Bold", textSize 12]) `styleBasic`
+                        [bgColor btnColor]
+                      , separatorLine `styleBasic` [fgColor btnColor]
+                      , spacer
+                      , hstack
+                          [ label "URI :" `styleBasic`
+                            [width 30, textFont "Bold"]
+                          , spacer
+                          , textArea uriString `styleBasic`
+                            [width 170, height 30]
+                          ]
+                      , spacer
+                      , box_
+                          [alignMiddle]
+                          (hstack
+                             [ spacer
+                             , button "Cancel" ClosePayUsingURI
+                             , spacer
+                             , mainButton "Process" ProcIfValidURI
+                             , spacer
+                             ])
+                      ]) `styleBasic`
+                 [radius 4, border 2 btnColor, bgColor white, padding 4]
+               , filler
+               ]
+           , filler
+           ]) `styleBasic`
+      [bgColor (white & L.a .~ 0.5)]
 
 generateQRCodes :: Config -> IO ()
 generateQRCodes config = do
@@ -1216,6 +1458,14 @@ handleEvent wenv node model evt =
         False
       ]
     ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
+    ViewingKeysClicked ->
+      [Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
+    NewAddress vk ->
+      [ Model $
+        model & confirmTitle ?~ "New Address" & confirmCancel .~ "Cancel" &
+        menuPopup .~
+        False
+      ]
     ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
     ShowSend ->
       [ Model $
@@ -1236,7 +1486,7 @@ handleEvent wenv node model evt =
                   (model ^. network)
                   (entityKey acc)
                   (zcashWalletLastSync $ entityVal wal)
-                  (model ^. sendAmount)
+                  (fromFloatDigits $ model ^. sendAmount)
                   (model ^. sendRecipient)
                   (model ^. sendMemo)
                   (model ^. privacyChoice)
@@ -1294,11 +1544,13 @@ handleEvent wenv node model evt =
         UpdateBalance <$> do
           dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
           case selectAccount i of
-            Nothing -> return (0, 0)
+            Nothing -> return (0, 0, 0, 0)
             Just acc -> do
               b <- getBalance dbPool $ entityKey acc
               u <- getUnconfirmedBalance dbPool $ entityKey acc
-              return (b, u)
+              s <- getShieldedBalance dbPool $ entityKey acc
+              t <- getTransparentBalance dbPool $ entityKey acc
+              return (b, u, s, t)
       , Event $ SetPool OrchardPool
       ]
     SwitchWal i ->
@@ -1310,9 +1562,9 @@ handleEvent wenv node model evt =
             Nothing -> return []
             Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
       ]
-    UpdateBalance (b, u) ->
+    UpdateBalance (b, u, s, t) ->
       [ Model $
-        model & balance .~ b & unconfBalance .~
+        model & balance .~ b & sBalance .~ s & tBalance .~ t & unconfBalance .~
         (if u == 0
            then Nothing
            else Just u)
@@ -1362,7 +1614,7 @@ handleEvent wenv node model evt =
         else [Event $ NewAccount currentWallet]
     LoadWallets a ->
       if not (null a)
-        then [ Model $ model & wallets .~ a
+        then [ Model $ model & wallets .~ a & modalMsg .~ Nothing
              , Event $ SwitchWal $ model ^. selWallet
              ]
         else [Event NewWallet]
@@ -1372,11 +1624,15 @@ handleEvent wenv node model evt =
     CloseTxId -> [Model $ model & showId .~ Nothing]
     ShowTx i -> [Model $ model & showTx ?~ i]
     TickUp ->
-      if (model ^. timer) < 90
+      if isNothing (model ^. modalMsg)
+        then if (model ^. timer) < 90
                then [Model $ model & timer .~ (1 + model ^. timer)]
                else if (model ^. barValue) == 1.0
-               then [ Model $ model & timer .~ 0 & barValue .~ 0.0
+                      then [ Model $
+                             model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~
+                             "Downloading blocks..."
                            , Producer $
+                             runNoLoggingT .
                              scanZebra
                                (c_dbPath $ model ^. configuration)
                                (c_zebraHost $ model ^. configuration)
@@ -1384,21 +1640,23 @@ handleEvent wenv node model evt =
                                (model ^. network)
                            ]
                       else [Model $ model & timer .~ 0]
-    SyncVal i ->
+        else [Model $ model & timer .~ 0]
-      if (i + model ^. barValue) >= 0.999
+    TreeSync -> [Model $ model & modalMsg ?~ "Updating commitment trees..."]
-        then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing
+    StartSync ->
+      [ Model $ model & modalMsg ?~ "Updating wallet..."
       , Task $ do
           case currentWallet of
             Nothing -> return $ ShowError "No wallet available"
             Just cW -> do
-                     runFileLoggingT "zenith.log" $
+              runNoLoggingT $ syncWallet (model ^. configuration) cW
-                       syncWallet (model ^. configuration) cW
               pool <-
-                       runNoLoggingT $
+                runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
-                       initPool $ c_dbPath $ model ^. configuration
               wL <- getWallets pool (model ^. network)
               return $ LoadWallets wL
       ]
+    SyncVal i ->
+      if (i + model ^. barValue) >= 0.999
+        then [Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing]
         else [ Model $
                model & barValue .~ validBarValue (i + model ^. barValue) &
                modalMsg ?~
@@ -1468,6 +1726,11 @@ handleEvent wenv node model evt =
       , setClipboardData $ ClipboardText a
       , Event $ ShowMessage "Address copied!!"
       ]
+    CopyViewingKey t v ->
+      [ setClipboardData ClipboardEmpty
+      , setClipboardData $ ClipboardText v
+      , Event $ ShowMessage (t <> " viewing key copied!!")
+      ]
     DeleteABEntry a ->
       [ Task $ deleteAdrBook (model ^. configuration) a
       , Model $
@@ -1483,7 +1746,99 @@ handleEvent wenv node model evt =
         model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
       ]
     CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
-    ShowShield ->  [ Model $ model & shieldZec .~ True & menuPopup .~ False ]
+    CloseShowVK ->
+      [ Model $
+        model & vkTypeName .~ "" & vkData .~ "" & viewingKeyDisplay .~ False
+      ]
+    --
+    -- Show Balance in FIAT
+    --
+    DisplayFIATBalance zpr abal ->
+      [ Model $
+        model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True &
+        menuPopup .~
+        False
+      ]
+    ShowFIATBalance ->
+      if model ^. network == MainNet
+        then [Task $ sfBalance (model ^. configuration)]
+        else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0
+             , Event $ ShowError "Balance conversion not available for TestNet"
+             ]
+    CloseFIATBalance -> [Model $ model & displayFIATBalance .~ False]
+    --
+    -- Show Viewing Keys
+    --
+    ShowViewingKey vkType vkText ->
+      case vkType of
+        VkFull ->
+          [ Model $
+            model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~
+            True &
+            menuPopup .~
+            False
+          ]
+        VkIncoming ->
+          [ Model $
+            model & vkTypeName .~ "Incoming" & vkData .~ vkText &
+            viewingKeyDisplay .~
+            True &
+            menuPopup .~
+            False
+          ]
+    --
+    -- Display PaymentURI Form
+    --
+    DisplayPaymentURI ->
+      [ Model $
+        model & paymentURIDisplay .~ True & uriString .~ "" & menuPopup .~ False
+      ]
+    ClosePaymentURI -> [Model $ model & paymentURIDisplay .~ False]
+    --
+    -- Display Pay using URI Form
+    --
+    DisplayPayUsingURI ->
+      [Model $ model & usepmtURIOverlay .~ True & menuPopup .~ False]
+    ClosePayUsingURI -> [Model $ model & usepmtURIOverlay .~ False]
+    ProcIfValidURI -> do
+      let zp = parseZcashPayment $ T.unpack (model ^. uriString)
+      case zp of
+        Right p -> do
+          case uriAmount p of
+            Just a ->
+              [ Model $
+                model & usepmtURIOverlay .~ False & openSend .~ True &
+                privacyChoice .~
+                Full &
+                recipientValid .~
+                False &
+                sendRecipient .~
+                T.pack (uriAddress p) &
+                sendAmount .~
+                realToFrac a &
+                sendMemo .~
+                (uriMemo p)
+              , Event $ ClosePaymentURI
+              ]
+            Nothing ->
+              [ Model $
+                model & usepmtURIOverlay .~ False & openSend .~ False &
+                uriString .~
+                ""
+              , Event $ ShowError "Invalid URI"
+              ]
+        Left e ->
+          [ Model $
+            model & usepmtURIOverlay .~ False & openSend .~ False & uriString .~
+            ""
+          , Event $ ShowError "Invalid URI"
+          ]
+    --
+    --
+    ShowShield ->
+      if model ^. tBalance > 0
+        then [Model $ model & shieldZec .~ True & menuPopup .~ False]
+        else [Event $ ShowError "No transparent funds in this account"]
     CloseShield -> [Model $ model & shieldZec .~ False]
     ShowDeShield -> [Model $ model & deShieldZec .~ True & menuPopup .~ False]
     CloseDeShield -> [Model $ model & deShieldZec .~ False]
@@ -1499,6 +1854,31 @@ handleEvent wenv node model evt =
           abList <- getAdrBook dbPool $ model ^. network
           return $ LoadAbList abList
       ]
+    SendDeShield ->
+      case currentAccount of
+        Nothing ->
+          [Event $ ShowError "No account available", Event CloseDeShield]
+        Just acc ->
+          [ Producer $
+            deshieldTransaction
+              (model ^. configuration)
+              (model ^. network)
+              (entityKey acc)
+              currentAddress
+              (fromFloatDigits $ model ^. sendAmount)
+          , Event CloseDeShield
+          ]
+    SendShield ->
+      case currentAccount of
+        Nothing -> [Event $ ShowError "No account available", Event CloseShield]
+        Just acc ->
+          [ Producer $
+            shieldTransaction
+              (model ^. configuration)
+              (model ^. network)
+              (entityKey acc)
+          , Event CloseShield
+          ]
   where
     currentWallet =
       if null (model ^. wallets)
@@ -1612,33 +1992,77 @@ handleEvent wenv node model evt =
       pool <- runNoLoggingT $ initPool $ c_dbPath config
       res <- liftIO $ updateAdrsInAdrBook pool d a a
       return $ ShowMessage "Address Book entry updated!!"
+    --
+    dbal :: Integer -> Double
+    dbal a = fromIntegral a
+    -- 
+    sfBalance :: Config -> IO AppEvent
+    sfBalance config = do
+      zpr <- liftIO $ getZcashPrice $ c_currencyCode config
+      case zpr of
+        Just zp -> do
+          let zbal = (dbal (model ^. balance)) / 100000000
+          return $ DisplayFIATBalance zp zbal
+        Nothing ->
+          return $
+          ShowMessage
+            ("Currency not supported [" <> c_currencyCode config <> "]")
+    --
+    procIfValidURI :: T.Text -> IO AppEvent
+    procIfValidURI ustr = do
+      return $ ShowSend
 
---                            model & recipientValid .~ ((model ^. privacyChoice) == Low)  ]
+scanZebra ::
-scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
+     T.Text
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> (AppEvent -> IO ())
+  -> NoLoggingT IO ()
 scanZebra dbPath zHost zPort net sendMsg = do
   bStatus <- liftIO $ checkBlockChain zHost zPort
-  pool <- runNoLoggingT $ initPool dbPath
+  pool <- liftIO $ runNoLoggingT $ initPool dbPath
-  b <- liftIO $ getMinBirthdayHeight pool
+  b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net
-  dbBlock <- getMaxBlock pool $ ZcashNetDB net
+  dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB net
-  chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
+  chkBlock <- liftIO $ checkIntegrity dbPath zHost zPort net dbBlock 1
-  unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
+  logDebugN $ "dbBlock: " <> T.pack (show dbBlock)
+  logDebugN $ "chkBlock: " <> T.pack (show chkBlock)
+  syncChk <- liftIO $ isSyncing pool
+  if syncChk
+    then liftIO $ sendMsg (ShowError "Sync already in progress")
+    else do
       let sb =
             if chkBlock == dbBlock
               then max dbBlock b
               else max chkBlock b
+      unless (chkBlock == dbBlock || chkBlock == 1) $
+        rewindWalletData pool sb $ ZcashNetDB net
       if sb > zgb_blocks bStatus || sb < 1
-    then sendMsg (ShowError "Invalid starting block for scan")
+        then liftIO $ sendMsg (ShowError "Invalid starting block for scan")
         else do
           let bList = [(sb + 1) .. (zgb_blocks bStatus)]
           if not (null bList)
             then do
               let step = (1.0 :: Float) / fromIntegral (length bList)
-          mapM_ (processBlock pool step) bList
+              _ <- liftIO $ startSync pool
-        else sendMsg (SyncVal 1.0)
+              mapM_ (liftIO . processBlock pool step) bList
-  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
+              confUp <-
+                liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
+                  IO
+                  (Either IOError ())
               case confUp of
-    Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
+                Left _e0 -> do
-    Right _ -> return ()
+                  _ <- liftIO $ completeSync pool Failed
+                  liftIO $
+                    sendMsg
+                      (ShowError "Failed to update unconfirmed transactions")
+                Right _ -> do
+                  liftIO $ sendMsg TreeSync
+                  _ <- updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
+                  _ <- liftIO $ completeSync pool Successful
+                  logDebugN "Starting wallet sync"
+                  liftIO $ sendMsg StartSync
+            else liftIO $ sendMsg (SyncVal 1.0)
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -1650,7 +2074,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
           "getblock"
           [Data.Aeson.String $ showt bl, jsonNumber 1]
       case r of
-        Left e1 -> sendMsg (ShowError $ showt e1)
+        Left e1 -> do
+          _ <- completeSync pool Failed
+          sendMsg (ShowError $ showt e1)
         Right blk -> do
           r2 <-
             liftIO $
@@ -1660,7 +2086,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
               "getblock"
               [Data.Aeson.String $ showt bl, jsonNumber 0]
           case r2 of
-            Left e2 -> sendMsg (ShowError $ showt e2)
+            Left e2 -> do
+              _ <- completeSync pool Failed
+              sendMsg (ShowError $ showt e2)
             Right hb -> do
               let blockTime = getBlockTime hb
               bi <-
@@ -1674,12 +2102,89 @@ scanZebra dbPath zHost zPort net sendMsg = do
               mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
               sendMsg (SyncVal step)
 
+shieldTransaction ::
+     Config -> ZcashNet -> ZcashAccountId -> (AppEvent -> IO ()) -> IO ()
+shieldTransaction config znet accId sendMsg = do
+  sendMsg $ ShowModal "Shielding funds..."
+  let dbPath = c_dbPath config
+  let zHost = c_zebraHost config
+  let zPort = c_zebraPort config
+  pool <- runNoLoggingT $ initPool dbPath
+  bl <- getChainTip zHost zPort
+  res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
+  forM_ res $ \case
+    Left e -> sendMsg $ ShowError $ T.pack (show e)
+    Right rawTx -> do
+      sendMsg $ ShowMsg "Transaction ready, sending to Zebra..."
+      resp <-
+        makeZebraCall
+          zHost
+          zPort
+          "sendrawtransaction"
+          [Data.Aeson.String $ toText rawTx]
+      case resp of
+        Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> T.pack (show e1)
+        Right txId -> sendMsg $ ShowTxId txId
+
+deshieldTransaction ::
+     Config
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Maybe (Entity WalletAddress)
+  -> Scientific
+  -> (AppEvent -> IO ())
+  -> IO ()
+deshieldTransaction config znet accId addR pnote sendMsg = do
+  case addR of
+    Nothing -> sendMsg $ ShowError "No address available"
+    Just addr -> do
+      sendMsg $ ShowModal "De-shielding funds..."
+      let dbPath = c_dbPath config
+      let zHost = c_zebraHost config
+      let zPort = c_zebraPort config
+      pool <- runNoLoggingT $ initPool dbPath
+      bl <- getChainTip zHost zPort
+      let tAddrMaybe =
+            Transparent <$>
+            ((decodeTransparentAddress .
+              E.encodeUtf8 . encodeTransparentReceiver znet) =<<
+             (t_rec =<<
+              (isValidUnifiedAddress .
+               E.encodeUtf8 . getUA . walletAddressUAddress)
+                (entityVal addr)))
+      case tAddrMaybe of
+        Nothing -> sendMsg $ ShowError "No transparent address available"
+        Just tAddr -> do
+          res <-
+            runNoLoggingT $
+            deshieldNotes
+              pool
+              zHost
+              zPort
+              znet
+              accId
+              bl
+              (ProposedNote (ValidAddressAPI tAddr) pnote Nothing)
+          case res of
+            Left e -> sendMsg $ ShowError $ T.pack (show e)
+            Right rawTx -> do
+              sendMsg $ ShowModal "Transaction ready, sending to Zebra..."
+              resp <-
+                makeZebraCall
+                  zHost
+                  zPort
+                  "sendrawtransaction"
+                  [Data.Aeson.String $ toText rawTx]
+              case resp of
+                Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1
+                Right txId -> sendMsg $ ShowTxId txId
+
 sendTransaction ::
      Config
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> Scientific
   -> T.Text
   -> T.Text
   -> PrivacyPolicy
@@ -1695,8 +2200,22 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
       let zPort = c_zebraPort config
       pool <- runNoLoggingT $ initPool dbPath
       res <-
-        runFileLoggingT "zenith.log" $
+        runNoLoggingT $
-        prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
+        prepareTxV2
+          pool
+          zHost
+          zPort
+          znet
+          accId
+          bl
+          [ ProposedNote
+              (ValidAddressAPI addr)
+              amt
+              (if memo == ""
+                 then Nothing
+                 else Just memo)
+          ]
+          policy
       case res of
         Left e -> sendMsg $ ShowError $ T.pack $ show e
         Right rawTx -> do
@@ -1778,6 +2297,14 @@ runZenithGUI config = do
                       then getUnconfirmedBalance pool $ entityKey $ head accList
                       else return 0
                   abList <- getAdrBook pool (zgb_net chainInfo)
+                  shieldBal <-
+                    if not (null accList)
+                      then getShieldedBalance pool $ entityKey $ head accList
+                      else return 0
+                  transBal <-
+                    if not (null accList)
+                      then getTransparentBalance pool $ entityKey $ head accList
+                      else return 0
                   let model =
                         AppModel
                           config
@@ -1837,10 +2364,20 @@ runZenithGUI config = do
                           Full
                           False
                           False
-                          0
+                          transBal
                           False
-                          0
+                          shieldBal
                           False
+                          False
+                          0.0
+                          0.0
+                          False
+                          False
+                          ""
+                          ""
+                          False
+                          False
+                          ""
                   startApp model handleEvent buildUI (params hD)
         Left _e -> print "Zebra not available"
   where

src/Zenith/RPC.hs

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

@@ -12,6 +12,7 @@ import Control.Monad.Logger
   , logInfoN
   , runFileLoggingT
   , runNoLoggingT
+  , runStderrLoggingT
   )
 import Data.Aeson
 import Data.HexString
@@ -31,12 +32,13 @@ import ZcashHaskell.Types
   , fromRawTBundle
   )
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
-import Zenith.Core (checkBlockChain, syncWallet)
+import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
 import Zenith.DB
   ( ZcashBlock(..)
   , ZcashBlockId
   , clearWalletData
   , clearWalletTransactions
+  , completeSync
   , getBlock
   , getMaxBlock
   , getMinBirthdayHeight
@@ -47,9 +49,16 @@ import Zenith.DB
   , saveBlock
   , saveConfs
   , saveTransaction
+  , startSync
   , updateWalletSync
   , upgradeQrTable
   )
+import Zenith.Types
+  ( Config(..)
+  , HexStringDB(..)
+  , ZcashNetDB(..)
+  , ZenithStatus(..)
+  )
 import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
 import Zenith.Utils (jsonNumber)
 
@@ -74,8 +83,9 @@ rescanZebra host port dbFilePath = do
       upgradeQrTable pool1
       clearWalletTransactions pool1
       clearWalletData pool1
+      _ <- startSync pool1
       dbBlock <- getMaxBlock pool1 znet
-      b <- liftIO $ getMinBirthdayHeight pool1
+      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"
@@ -99,6 +109,8 @@ rescanZebra host port dbFilePath = do
                 {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
                 {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
               print "Please wait..."
+          _ <- completeSync pool1 Successful
+          _ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
           print "Rescan complete"
 
 -- | Function to process a raw block and extract the transaction information
@@ -119,7 +131,9 @@ processBlock host port pool pg net 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 $
@@ -129,7 +143,9 @@ processBlock host port pool pg net 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
           bi <-
@@ -160,7 +176,9 @@ 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 ()
@@ -223,7 +241,7 @@ clearSync config = do
           w <- getWallets pool $ zgb_net chainInfo
           liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
           w' <- liftIO $ getWallets pool $ zgb_net chainInfo
-          r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
+          r <- runNoLoggingT $ mapM (syncWallet config) w'
           liftIO $ print r
 
 -- | Detect chain re-orgs
@@ -231,10 +249,11 @@ 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 b d =
+checkIntegrity dbP zHost zPort znet b d =
   if b < 1
     then return 1
     else do
@@ -248,10 +267,10 @@ checkIntegrity dbP zHost zPort b d =
         Left e -> throwIO $ userError e
         Right blk -> do
           pool <- runNoLoggingT $ initPool dbP
-          dbBlk <- getBlock pool b
+          dbBlk <- getBlock pool b $ ZcashNetDB znet
           case dbBlk of
-            Nothing -> throwIO $ userError "Block mismatch, rescan needed"
+            Nothing -> return 1
             Just dbBlk' ->
               if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
                 then return b
-                else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)
+                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

@@ -17,19 +17,30 @@ 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(..)
   )
 
@@ -101,6 +112,7 @@ data Config = Config
   , c_zenithUser :: !BS.ByteString
   , c_zenithPwd :: !BS.ByteString
   , c_zenithPort :: !Int
+  , c_currencyCode :: !T.Text
   } deriving (Eq, Prelude.Show)
 
 data ZcashPool
@@ -207,6 +219,51 @@ data PrivacyPolicy
 
 $(deriveJSON defaultOptions ''PrivacyPolicy)
 
+newtype ValidAddressAPI = ValidAddressAPI
+  { getVA :: ValidAddress
+  } deriving newtype (Eq, Show)
+
+instance ToJSON ValidAddressAPI where
+  toJSON (ValidAddressAPI va) =
+    case va of
+      Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
+      Sapling sa ->
+        maybe
+          Data.Aeson.Null
+          Data.Aeson.String
+          (encodeSaplingAddress (net_type sa) (sa_receiver sa))
+      Transparent ta ->
+        Data.Aeson.String $
+        encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
+      Exchange ea ->
+        maybe
+          Data.Aeson.Null
+          Data.Aeson.String
+          (encodeExchangeAddress (ex_network ea) (ex_address ea))
+
+data ProposedNote = ProposedNote
+  { pn_addr :: !ValidAddressAPI
+  , pn_amt :: !Scientific
+  , pn_memo :: !(Maybe T.Text)
+  } deriving (Eq, Prelude.Show)
+
+instance FromJSON ProposedNote where
+  parseJSON =
+    withObject "ProposedNote" $ \obj -> do
+      a <- obj .: "address"
+      n <- obj .: "amount"
+      m <- obj .:? "memo"
+      case parseAddress (E.encodeUtf8 a) of
+        Nothing -> fail "Invalid address"
+        Just a' ->
+          if n > 0 && n < 21000000
+            then pure $ ProposedNote (ValidAddressAPI a') n m
+            else fail "Invalid amount"
+
+instance ToJSON ProposedNote where
+  toJSON (ProposedNote a n m) =
+    object ["address" .= a, "amount" .= n, "memo" .= m]
+
 data ShieldDeshieldOp
   = Shield
   | Deshield
@@ -451,3 +508,12 @@ encodeHexText' t =
   if T.length t > 0
     then C.unpack . B64.encode $ E.encodeUtf8 t
     else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
+
+-- | Define a data structure for the parsed components
+data ZcashPaymentURI = ZcashPaymentURI
+  { uriAddress :: String
+  , uriAmount :: Maybe Double
+  , uriMemo :: T.Text
+  , uriLabel :: Maybe String
+  , uriMessage :: Maybe String
+  } deriving (Show, Eq)

src/Zenith/Utils.hs

@@ -2,37 +2,59 @@
 
 module Zenith.Utils where
 
+import Control.Exception (SomeException, try)
+import Control.Monad (when)
 import Data.Aeson
+import qualified Data.Aeson.Key as K
+import qualified Data.Aeson.KeyMap as KM
+import Data.Aeson.Types (parseMaybe)
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.Char8 as BL
 import Data.Char (isAlphaNum, isSpace)
 import Data.Functor (void)
 import Data.Maybe
 import Data.Ord (clamp)
 import Data.Scientific (Scientific(..), scientific)
+import Data.Scientific (Scientific, toRealFloat)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import qualified Data.Text.Encoding as TE
+import Network.HTTP.Simple
 import System.Directory
 import System.Process (createProcess_, shell)
+import Text.Printf (printf)
+import Text.Read (readMaybe)
 import Text.Regex.Posix
-import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress)
+import ZcashHaskell.Orchard
+  ( encodeUnifiedAddress
+  , isValidUnifiedAddress
+  , parseAddress
+  )
 import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
 import ZcashHaskell.Transparent
   ( decodeExchangeAddress
   , decodeTransparentAddress
   )
 import ZcashHaskell.Types
-  ( SaplingAddress(..)
+  ( ExchangeAddress(..)
+  , ExchangeAddress(..)
+  , SaplingAddress(..)
   , TransparentAddress(..)
   , UnifiedAddress(..)
-  , ZcashNet(..)
   , ValidAddress(..)
-  , ExchangeAddress(..)
+  , ValidAddress(..)
+  , ZcashNet(..)
   )
+import ZcashHaskell.Utils (makeZebraCall)
 import Zenith.Types
   ( AddressGroup(..)
+  , PrivacyPolicy(..)
   , UnifiedAddressDB(..)
   , ZcashAddress(..)
+  , ZcashPaymentURI(..)
   , ZcashPool(..)
-  , PrivacyPolicy(..)
   )
 
 -- | Helper function to convert numbers into JSON
@@ -47,7 +69,7 @@ displayZec s
   | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC"
   | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
 
--- | Helper function to display small amounts of ZEC
+-- | Helper function to display small amounts of TAZ
 displayTaz :: Integer -> String
 displayTaz s
   | abs s < 100 = show s ++ " tazs"
@@ -150,21 +172,24 @@ isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
 isRecipientValidGUI p a = do
   let adr = parseAddress (E.encodeUtf8 a)
   case p of
-    Full -> case adr of  
+    Full ->
+      case adr of
         Just a ->
           case a of
             Unified ua -> True
             Sapling sa -> True
             _ -> False
         Nothing -> False
-    Medium -> case adr of 
+    Medium ->
+      case adr of
         Just a ->
           case a of
             Unified ua -> True
             Sapling sa -> True
             _ -> False
         Nothing -> False
-    Low -> case adr of  
+    Low ->
+      case adr of
         Just a ->
           case a of
             Unified ua -> True
@@ -172,7 +197,8 @@ isRecipientValidGUI p a  = do
             Transparent ta -> True
             _ -> False
         Nothing -> False
-    None -> case adr of  
+    None ->
+      case adr of
         Just a ->
           case a of
             Transparent ta -> True
@@ -232,3 +258,73 @@ padWithZero n 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
+
+-- Function to fetch Zcash price from CoinGecko
+getZcashPrice :: T.Text -> IO (Maybe Double)
+getZcashPrice currency = do
+  let url =
+        "https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <>
+        T.unpack currency
+  response <- httpJSONEither (parseRequest_ url)
+  case getResponseBody response of
+    Right (Object obj)
+        -- Extract "zcash" object
+     -> do
+      case KM.lookup "zcash" obj of
+        Just (Object zcashObj)
+            -- Extract the currency price
+         ->
+          case KM.lookup (K.fromText (T.toLower currency)) zcashObj of
+            Just (Number price) -> return (Just (toRealFloat price))
+            _ -> return Nothing
+        _ -> return Nothing
+    _ -> return Nothing
+
+-- Parse memo result to convert it to a ByteString
+processEither :: Either String BC.ByteString -> BC.ByteString
+processEither (Right bs) = bs
+processEither (Left e) = BC.pack e -- Returns the error message
+
+-- Parse the query string into key-value pairs 
+parseQuery :: String -> [(String, String)]
+parseQuery query = map (breakOn '=') (splitOn '&' query)
+  where
+    splitOn :: Char -> String -> [String]
+    splitOn _ [] = [""]
+    splitOn delim (c:cs)
+      | c == delim = "" : rest
+      | otherwise = (c : head rest) : tail rest
+      where
+        rest = splitOn delim cs
+    breakOn :: Char -> String -> (String, String)
+    breakOn delim str = (key, drop 1 value)
+      where
+        (key, value) = span (/= delim) str
+
+-- Parse a ZIP-321 encoded string into a ZcashPayment structure
+parseZcashPayment :: String -> Either String ZcashPaymentURI
+parseZcashPayment input
+  | not (T.isPrefixOf "zcash:" (T.pack input)) =
+    Left "Invalid scheme: must start with 'zcash:'"
+  | otherwise =
+    let (addrPart, queryPart) = break (== '?') (drop 6 input)
+        queryParams = parseQuery (drop 1 queryPart)
+     in Right
+          ZcashPaymentURI
+            { uriAddress = addrPart
+            , uriAmount = lookup "amount" queryParams >>= readMaybe
+            , uriMemo =
+                case lookup "memo" queryParams of
+                  Just m ->
+                    T.pack (BC.unpack (processEither $ B64.decode $ BC.pack m))
+                  _ -> ""
+            , uriLabel = lookup "label" queryParams
+            , uriMessage = lookup "message" queryParams
+            }

test/ServerSpec.hs

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

zcash-haskell

@@ -1 +1 @@
-Subproject commit 003293cc3f978c146824d0695c5c458cf2cc9bb5
+Subproject commit cfa862ec9495e810e7296fa6fe724b46dbe0ee52

zenith-openrpc.json

@@ -132,6 +132,7 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/DuplicateName" }
       ]
     },
@@ -228,6 +229,7 @@
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
         { "$ref": "#/components/errors/DuplicateName" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/InvalidWallet" }
       ]
     },
@@ -444,6 +446,7 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/InvalidAccount" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/DuplicateName" }
       ]
     },
@@ -593,10 +596,11 @@
     {
       "name": "sendmany",
       "summary": "Send transaction(s)",
-      "description": "Send one or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
+      "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": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
+      "tags": [],
       "params": [
         { "$ref": "#/components/contentDescriptors/AccountId"},
+        { "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
         { "$ref": "#/components/contentDescriptors/TxRequestArray"}
       ],
       "paramStructure": "by-position",
@@ -610,14 +614,19 @@
       "examples": [
         {
           "name": "Send a transaction",
-          "summary": "Send one transaction",
+          "summary": "Send a transaction",
-          "description": "Send a single 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",
@@ -640,7 +649,7 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
-        { "$ref": "#/components/errors/InvalidRecipient" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/InvalidAccount" }
       ]
     },
@@ -736,6 +745,16 @@
           "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": {
@@ -814,8 +833,7 @@
         "properties": {
           "address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
           "amount": { "type": "number", "description": "The amount to send in ZEC"},
-          "memo": { "type": "string", "description": "The shielded memo to include, if applicable"},
+          "memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
-          "privacy": { "type": "string", "enum": ["None", "Low", "Medium", "Full"], "description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools and deshielding transactions. `Low` allows to spend transparent funds into shielded pools. `None` allows for transparent funds to be spent to transparent addresses."}
         }
       }
     },
@@ -872,6 +890,10 @@
       "InvalidRecipient": {
         "code": -32011,
         "message": "The provided recipient address is not valid."
+      },
+      "ZenithBusy": {
+        "code": -32012,
+        "message": "The Zenith server is syncing, please try again later."
       }
     }
   }

zenith.cabal

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

zenith.cfg

@@ -1,5 +1,38 @@
+# 
+# Zenith Configuration File
+# 
+# -------------------------------------------------------------
+# nodeUser - 
+# -------------------------------------------------------------
 nodeUser = "user"
+# -------------------------------------------------------------
+# nodePwd -
 nodePwd = "superSecret"
-dbFilePath = "zenith.db"
+# -------------------------------------------------------------
+# dbFileName  - contains the SQLite database name used for
+#			    keeping all Zenith's data
+#               default = zenith.db 
+#
+dbFileName = "zenith.db"
+# -------------------------------------------------------------
+# zebraHost   - Zebra IP 
+#				Default - "127.0.0.1" 
 zebraHost = "127.0.0.1"
+# -------------------------------------------------------------
+# zebraPort   - Port used for access Zebra API endpoints
+#			    must be the same port configured for your 
+#				Zebra node
 zebraPort = 18232
+# -------------------------------------------------------------
+# currencyCode  - ISO 4217 currency code 
+#
+#  Example of currency codes are:
+#
+#      United States -> currencyCode = "usd"	
+#      Canada        -> currencyCode = "cnd"	
+#      Australia     -> currencyCode = "aud"
+#      Euro Region   -> currencyCode = "eur"	
+#      Great Britain -> currencyCode = "gbp"	
+#      Japan         -> currencyCode = "jpy"		
+#                 
+currencyCode = "usd"